From 677770640cac2710a0f2ce29591fdb81ad5cf41c Mon Sep 17 00:00:00 2001 From: Sylvain Le Gall Date: Tue, 11 Jul 2006 23:18:43 +0200 Subject: Import ocamldap_2.1.8.orig.tar.gz [dgit import orig ocamldap_2.1.8.orig.tar.gz] --- .DS_Store | Bin 0 -> 6148 bytes ._.DS_Store | Bin 0 -> 82 bytes COPYING | 17 + Changelog | 450 +++++++ INSTALL | 17 + META | 4 + Makefile | 30 + OCamlMakefile | 1119 +++++++++++++++++ README | 56 + doc/ocamldap/html/Lber.html | 254 ++++ doc/ocamldap/html/Ldap_dn.html | 72 ++ doc/ocamldap/html/Ldap_error.html | 50 + doc/ocamldap/html/Ldap_filter.html | 91 ++ doc/ocamldap/html/Ldap_funclient.html | 177 +++ doc/ocamldap/html/Ldap_funserver.html | 168 +++ doc/ocamldap/html/Ldap_mutex.html | 77 ++ doc/ocamldap/html/Ldap_mutex.mutex.html | 44 + doc/ocamldap/html/Ldap_mutex.mutex_t.html | 40 + .../html/Ldap_mutex.object_lock_table.html | 44 + .../html/Ldap_mutex.object_lock_table_t.html | 40 + doc/ocamldap/html/Ldap_ooclient.OrdOid.html | 41 + doc/ocamldap/html/Ldap_ooclient.OrdStr.html | 33 + doc/ocamldap/html/Ldap_ooclient.Setstr.html | 44 + doc/ocamldap/html/Ldap_ooclient.html | 363 ++++++ doc/ocamldap/html/Ldap_ooclient.ldapaccount.html | 87 ++ .../html/Ldap_ooclient.ldapadvisorytxcon.html | 62 + doc/ocamldap/html/Ldap_ooclient.ldapcon.html | 200 +++ doc/ocamldap/html/Ldap_ooclient.ldapentry.html | 103 ++ doc/ocamldap/html/Ldap_ooclient.ldapentry_t.html | 37 + doc/ocamldap/html/Ldap_ooclient.mutex.html | 45 + doc/ocamldap/html/Ldap_ooclient.mutex_t.html | 41 + .../html/Ldap_ooclient.object_lock_table.html | 45 + .../html/Ldap_ooclient.object_lock_table_t.html | 39 + doc/ocamldap/html/Ldap_ooclient.scldapentry.html | 136 ++ doc/ocamldap/html/Ldap_protocol.html | 58 + doc/ocamldap/html/Ldap_schemaparser.Lcstring.html | 40 + doc/ocamldap/html/Ldap_schemaparser.Oid.html | 40 + doc/ocamldap/html/Ldap_schemaparser.html | 310 +++++ doc/ocamldap/html/Ldap_toplevel.html | 65 + doc/ocamldap/html/Ldap_txooclient.html | 58 + .../html/Ldap_txooclient.ldapadvisorytxcon.html | 59 + doc/ocamldap/html/Ldap_types.html | 807 ++++++++++++ doc/ocamldap/html/Ldap_url.html | 52 + doc/ocamldap/html/Ldif_changerec_oo.change.html | 36 + doc/ocamldap/html/Ldif_changerec_oo.html | 57 + doc/ocamldap/html/Ldif_oo.html | 61 + doc/ocamldap/html/Ldif_oo.ldif.html | 36 + doc/ocamldap/html/index.html | 109 ++ doc/ocamldap/html/index_attributes.html | 34 + doc/ocamldap/html/index_class_types.html | 54 + doc/ocamldap/html/index_classes.html | 75 ++ doc/ocamldap/html/index_exceptions.html | 167 +++ doc/ocamldap/html/index_methods.html | 517 ++++++++ doc/ocamldap/html/index_module_types.html | 34 + doc/ocamldap/html/index_modules.html | 134 ++ doc/ocamldap/html/index_types.html | 247 ++++ doc/ocamldap/html/index_values.html | 528 ++++++++ doc/ocamldap/html/style.css | 33 + doc/ocamldap/html/type_Lber.html | 88 ++ doc/ocamldap/html/type_Ldap_dn.html | 35 + doc/ocamldap/html/type_Ldap_error.html | 74 ++ doc/ocamldap/html/type_Ldap_filter.html | 34 + doc/ocamldap/html/type_Ldap_funclient.html | 80 ++ doc/ocamldap/html/type_Ldap_funserver.html | 81 ++ doc/ocamldap/html/type_Ldap_mutex.html | 51 + doc/ocamldap/html/type_Ldap_mutex.mutex.html | 31 + doc/ocamldap/html/type_Ldap_mutex.mutex_t.html | 29 + .../html/type_Ldap_mutex.object_lock_table.html | 36 + .../html/type_Ldap_mutex.object_lock_table_t.html | 32 + doc/ocamldap/html/type_Ldap_ooclient.OrdOid.html | 32 + doc/ocamldap/html/type_Ldap_ooclient.OrdStr.html | 25 + doc/ocamldap/html/type_Ldap_ooclient.Setstr.html | 78 ++ doc/ocamldap/html/type_Ldap_ooclient.html | 310 +++++ .../html/type_Ldap_ooclient.ldapaccount.html | 66 + .../html/type_Ldap_ooclient.ldapadvisorytxcon.html | 69 ++ doc/ocamldap/html/type_Ldap_ooclient.ldapcon.html | 61 + .../html/type_Ldap_ooclient.ldapentry.html | 48 + .../html/type_Ldap_ooclient.ldapentry_t.html | 48 + doc/ocamldap/html/type_Ldap_ooclient.mutex.html | 30 + doc/ocamldap/html/type_Ldap_ooclient.mutex_t.html | 28 + .../html/type_Ldap_ooclient.object_lock_table.html | 35 + .../type_Ldap_ooclient.object_lock_table_t.html | 31 + .../html/type_Ldap_ooclient.scldapentry.html | 56 + doc/ocamldap/html/type_Ldap_protocol.html | 34 + .../html/type_Ldap_schemaparser.Lcstring.html | 35 + doc/ocamldap/html/type_Ldap_schemaparser.Oid.html | 34 + doc/ocamldap/html/type_Ldap_schemaparser.html | 97 ++ doc/ocamldap/html/type_Ldap_toplevel.html | 44 + doc/ocamldap/html/type_Ldap_txooclient.html | 84 ++ .../type_Ldap_txooclient.ldapadvisorytxcon.html | 75 ++ doc/ocamldap/html/type_Ldap_types.html | 242 ++++ doc/ocamldap/html/type_Ldap_url.html | 32 + .../html/type_Ldif_changerec_oo.change.html | 37 + doc/ocamldap/html/type_Ldif_changerec_oo.html | 44 + doc/ocamldap/html/type_Ldif_oo.html | 50 + doc/ocamldap/html/type_Ldif_oo.ldif.html | 37 + lber.ml | 680 ++++++++++ lber.mli | 150 +++ lber_tests.ml | 49 + ldap_dn.ml | 133 ++ ldap_dn.mli | 53 + ldap_dnlexer.mll | 56 + ldap_dnparser.mly | 127 ++ ldap_error.ml | 64 + ldap_error.mli | 51 + ldap_filter.ml | 163 +++ ldap_filter.mli | 47 + ldap_filterlexer.mll | 100 ++ ldap_filterparser.mly | 87 ++ ldap_funclient.ml | 389 ++++++ ldap_funclient.mli | 197 +++ ldap_funserver.ml | 401 ++++++ ldap_funserver.mli | 79 ++ ldap_mutex.ml | 116 ++ ldap_mutex.mli | 51 + ldap_ooclient.ml | 1310 ++++++++++++++++++++ ldap_ooclient.mli | 730 +++++++++++ ldap_protocol.ml | 1125 +++++++++++++++++ ldap_protocol.mli | 42 + ldap_schemalexer.mll | 145 +++ ldap_schemaparser.ml | 324 +++++ ldap_schemaparser.mli | 92 ++ ldap_toplevel.ml | 72 ++ ldap_toplevel.mli | 58 + ldap_txooclient.ml | 184 +++ ldap_txooclient.mli | 74 ++ ldap_types.ml | 303 +++++ ldap_types.mli | 303 +++++ ldap_url.ml | 33 + ldap_url.mli | 32 + ldap_urllexer.mll | 78 ++ ldap_urlparser.cmi | Bin 0 -> 628 bytes ldap_urlparser.cmo | Bin 0 -> 6071 bytes ldap_urlparser.mli | 19 + ldif_changerec_lexer.mll | 47 + ldif_changerec_oo.ml | 94 ++ ldif_changerec_oo.mli | 48 + ldif_changerec_parser.mly | 101 ++ ldif_oo.ml | 145 +++ ldif_oo.mli | 56 + ldif_parser.ml | 223 ++++ mutex.schema | 35 + test.ml | 85 ++ testldif.ml | 30 + testoo.cmi | Bin 0 -> 664 bytes testoo.ml | 61 + ulist.ml | 35 + 147 files changed, 18847 insertions(+) create mode 100644 .DS_Store create mode 100644 ._.DS_Store create mode 100644 COPYING create mode 100644 Changelog create mode 100644 INSTALL create mode 100644 META create mode 100644 Makefile create mode 100644 OCamlMakefile create mode 100644 README create mode 100644 doc/ocamldap/html/Lber.html create mode 100644 doc/ocamldap/html/Ldap_dn.html create mode 100644 doc/ocamldap/html/Ldap_error.html create mode 100644 doc/ocamldap/html/Ldap_filter.html create mode 100644 doc/ocamldap/html/Ldap_funclient.html create mode 100644 doc/ocamldap/html/Ldap_funserver.html create mode 100644 doc/ocamldap/html/Ldap_mutex.html create mode 100644 doc/ocamldap/html/Ldap_mutex.mutex.html create mode 100644 doc/ocamldap/html/Ldap_mutex.mutex_t.html create mode 100644 doc/ocamldap/html/Ldap_mutex.object_lock_table.html create mode 100644 doc/ocamldap/html/Ldap_mutex.object_lock_table_t.html create mode 100644 doc/ocamldap/html/Ldap_ooclient.OrdOid.html create mode 100644 doc/ocamldap/html/Ldap_ooclient.OrdStr.html create mode 100644 doc/ocamldap/html/Ldap_ooclient.Setstr.html create mode 100644 doc/ocamldap/html/Ldap_ooclient.html create mode 100644 doc/ocamldap/html/Ldap_ooclient.ldapaccount.html create mode 100644 doc/ocamldap/html/Ldap_ooclient.ldapadvisorytxcon.html create mode 100644 doc/ocamldap/html/Ldap_ooclient.ldapcon.html create mode 100644 doc/ocamldap/html/Ldap_ooclient.ldapentry.html create mode 100644 doc/ocamldap/html/Ldap_ooclient.ldapentry_t.html create mode 100644 doc/ocamldap/html/Ldap_ooclient.mutex.html create mode 100644 doc/ocamldap/html/Ldap_ooclient.mutex_t.html create mode 100644 doc/ocamldap/html/Ldap_ooclient.object_lock_table.html create mode 100644 doc/ocamldap/html/Ldap_ooclient.object_lock_table_t.html create mode 100644 doc/ocamldap/html/Ldap_ooclient.scldapentry.html create mode 100644 doc/ocamldap/html/Ldap_protocol.html create mode 100644 doc/ocamldap/html/Ldap_schemaparser.Lcstring.html create mode 100644 doc/ocamldap/html/Ldap_schemaparser.Oid.html create mode 100644 doc/ocamldap/html/Ldap_schemaparser.html create mode 100644 doc/ocamldap/html/Ldap_toplevel.html create mode 100644 doc/ocamldap/html/Ldap_txooclient.html create mode 100644 doc/ocamldap/html/Ldap_txooclient.ldapadvisorytxcon.html create mode 100644 doc/ocamldap/html/Ldap_types.html create mode 100644 doc/ocamldap/html/Ldap_url.html create mode 100644 doc/ocamldap/html/Ldif_changerec_oo.change.html create mode 100644 doc/ocamldap/html/Ldif_changerec_oo.html create mode 100644 doc/ocamldap/html/Ldif_oo.html create mode 100644 doc/ocamldap/html/Ldif_oo.ldif.html create mode 100644 doc/ocamldap/html/index.html create mode 100644 doc/ocamldap/html/index_attributes.html create mode 100644 doc/ocamldap/html/index_class_types.html create mode 100644 doc/ocamldap/html/index_classes.html create mode 100644 doc/ocamldap/html/index_exceptions.html create mode 100644 doc/ocamldap/html/index_methods.html create mode 100644 doc/ocamldap/html/index_module_types.html create mode 100644 doc/ocamldap/html/index_modules.html create mode 100644 doc/ocamldap/html/index_types.html create mode 100644 doc/ocamldap/html/index_values.html create mode 100644 doc/ocamldap/html/style.css create mode 100644 doc/ocamldap/html/type_Lber.html create mode 100644 doc/ocamldap/html/type_Ldap_dn.html create mode 100644 doc/ocamldap/html/type_Ldap_error.html create mode 100644 doc/ocamldap/html/type_Ldap_filter.html create mode 100644 doc/ocamldap/html/type_Ldap_funclient.html create mode 100644 doc/ocamldap/html/type_Ldap_funserver.html create mode 100644 doc/ocamldap/html/type_Ldap_mutex.html create mode 100644 doc/ocamldap/html/type_Ldap_mutex.mutex.html create mode 100644 doc/ocamldap/html/type_Ldap_mutex.mutex_t.html create mode 100644 doc/ocamldap/html/type_Ldap_mutex.object_lock_table.html create mode 100644 doc/ocamldap/html/type_Ldap_mutex.object_lock_table_t.html create mode 100644 doc/ocamldap/html/type_Ldap_ooclient.OrdOid.html create mode 100644 doc/ocamldap/html/type_Ldap_ooclient.OrdStr.html create mode 100644 doc/ocamldap/html/type_Ldap_ooclient.Setstr.html create mode 100644 doc/ocamldap/html/type_Ldap_ooclient.html create mode 100644 doc/ocamldap/html/type_Ldap_ooclient.ldapaccount.html create mode 100644 doc/ocamldap/html/type_Ldap_ooclient.ldapadvisorytxcon.html create mode 100644 doc/ocamldap/html/type_Ldap_ooclient.ldapcon.html create mode 100644 doc/ocamldap/html/type_Ldap_ooclient.ldapentry.html create mode 100644 doc/ocamldap/html/type_Ldap_ooclient.ldapentry_t.html create mode 100644 doc/ocamldap/html/type_Ldap_ooclient.mutex.html create mode 100644 doc/ocamldap/html/type_Ldap_ooclient.mutex_t.html create mode 100644 doc/ocamldap/html/type_Ldap_ooclient.object_lock_table.html create mode 100644 doc/ocamldap/html/type_Ldap_ooclient.object_lock_table_t.html create mode 100644 doc/ocamldap/html/type_Ldap_ooclient.scldapentry.html create mode 100644 doc/ocamldap/html/type_Ldap_protocol.html create mode 100644 doc/ocamldap/html/type_Ldap_schemaparser.Lcstring.html create mode 100644 doc/ocamldap/html/type_Ldap_schemaparser.Oid.html create mode 100644 doc/ocamldap/html/type_Ldap_schemaparser.html create mode 100644 doc/ocamldap/html/type_Ldap_toplevel.html create mode 100644 doc/ocamldap/html/type_Ldap_txooclient.html create mode 100644 doc/ocamldap/html/type_Ldap_txooclient.ldapadvisorytxcon.html create mode 100644 doc/ocamldap/html/type_Ldap_types.html create mode 100644 doc/ocamldap/html/type_Ldap_url.html create mode 100644 doc/ocamldap/html/type_Ldif_changerec_oo.change.html create mode 100644 doc/ocamldap/html/type_Ldif_changerec_oo.html create mode 100644 doc/ocamldap/html/type_Ldif_oo.html create mode 100644 doc/ocamldap/html/type_Ldif_oo.ldif.html create mode 100644 lber.ml create mode 100644 lber.mli create mode 100644 lber_tests.ml create mode 100644 ldap_dn.ml create mode 100644 ldap_dn.mli create mode 100644 ldap_dnlexer.mll create mode 100644 ldap_dnparser.mly create mode 100644 ldap_error.ml create mode 100644 ldap_error.mli create mode 100644 ldap_filter.ml create mode 100644 ldap_filter.mli create mode 100644 ldap_filterlexer.mll create mode 100644 ldap_filterparser.mly create mode 100644 ldap_funclient.ml create mode 100644 ldap_funclient.mli create mode 100644 ldap_funserver.ml create mode 100644 ldap_funserver.mli create mode 100644 ldap_mutex.ml create mode 100644 ldap_mutex.mli create mode 100644 ldap_ooclient.ml create mode 100644 ldap_ooclient.mli create mode 100644 ldap_protocol.ml create mode 100644 ldap_protocol.mli create mode 100644 ldap_schemalexer.mll create mode 100644 ldap_schemaparser.ml create mode 100644 ldap_schemaparser.mli create mode 100644 ldap_toplevel.ml create mode 100644 ldap_toplevel.mli create mode 100644 ldap_txooclient.ml create mode 100644 ldap_txooclient.mli create mode 100644 ldap_types.ml create mode 100644 ldap_types.mli create mode 100644 ldap_url.ml create mode 100644 ldap_url.mli create mode 100644 ldap_urllexer.mll create mode 100644 ldap_urlparser.cmi create mode 100644 ldap_urlparser.cmo create mode 100644 ldap_urlparser.mli create mode 100644 ldif_changerec_lexer.mll create mode 100644 ldif_changerec_oo.ml create mode 100644 ldif_changerec_oo.mli create mode 100644 ldif_changerec_parser.mly create mode 100644 ldif_oo.ml create mode 100644 ldif_oo.mli create mode 100644 ldif_parser.ml create mode 100644 mutex.schema create mode 100644 test.ml create mode 100644 testldif.ml create mode 100644 testoo.cmi create mode 100644 testoo.ml create mode 100644 ulist.ml diff --git a/.DS_Store b/.DS_Store new file mode 100644 index 0000000..7625182 Binary files /dev/null and b/.DS_Store differ diff --git a/._.DS_Store b/._.DS_Store new file mode 100644 index 0000000..460d887 Binary files /dev/null and b/._.DS_Store differ diff --git a/COPYING b/COPYING new file mode 100644 index 0000000..548fb94 --- /dev/null +++ b/COPYING @@ -0,0 +1,17 @@ +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 diff --git a/Changelog b/Changelog new file mode 100644 index 0000000..570e156 --- /dev/null +++ b/Changelog @@ -0,0 +1,450 @@ +2.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 diff --git a/INSTALL b/INSTALL new file mode 100644 index 0000000..4d505d4 --- /dev/null +++ b/INSTALL @@ -0,0 +1,17 @@ +* 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 diff --git a/META b/META new file mode 100644 index 0000000..24ae9fa --- /dev/null +++ b/META @@ -0,0 +1,4 @@ +requires="netstring str ssl" +version="2.1.5" +archive(byte)="ocamldap.cma" +archive(native)="ocamldap.cmxa" diff --git a/Makefile b/Makefile new file mode 100644 index 0000000..7d68f30 --- /dev/null +++ b/Makefile @@ -0,0 +1,30 @@ +-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 diff --git a/OCamlMakefile b/OCamlMakefile new file mode 100644 index 0000000..7324c61 --- /dev/null +++ b/OCamlMakefile @@ -0,0 +1,1119 @@ +########################################################################### +# 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) $( + + + + + + + + + + + + + + + + + + + + + + + + + + + +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.
+
+ \ No newline at end of file diff --git a/doc/ocamldap/html/Ldap_dn.html b/doc/ocamldap/html/Ldap_dn.html new file mode 100644 index 0000000..698aa69 --- /dev/null +++ b/doc/ocamldap/html/Ldap_dn.html @@ -0,0 +1,72 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +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.
+
+ \ No newline at end of file diff --git a/doc/ocamldap/html/Ldap_error.html b/doc/ocamldap/html/Ldap_error.html new file mode 100644 index 0000000..36e16d0 --- /dev/null +++ b/doc/ocamldap/html/Ldap_error.html @@ -0,0 +1,50 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +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
+
+ \ No newline at end of file diff --git a/doc/ocamldap/html/Ldap_filter.html b/doc/ocamldap/html/Ldap_filter.html new file mode 100644 index 0000000..2e34c5c --- /dev/null +++ b/doc/ocamldap/html/Ldap_filter.html @@ -0,0 +1,91 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +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.
+
+ \ No newline at end of file diff --git a/doc/ocamldap/html/Ldap_funclient.html b/doc/ocamldap/html/Ldap_funclient.html new file mode 100644 index 0000000..5211324 --- /dev/null +++ b/doc/ocamldap/html/Ldap_funclient.html @@ -0,0 +1,177 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +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
  • LDAP_Failure any + failure to connect to the server will result in LDAP_Failure with + the result_code set to `LOCAL_ERROR.
    • +
  • Failure May raise + Failure "int_of_string" if you pass it a malformed url. May also + raise various lexer errors under the same conditions.
    • +
+
+
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
  • LDAP_Failure for bind errors such as `INVALID_CREDENTIALS
    • +
  • Decoding_error for decoder errors (unlikely, probably a bug)
    • +
  • Encoding_error for encoder errors (unlikely, probably a bug)
    • +
+
+
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
  • LDAP_Failure for immediate errors (bad filter, etc)
    • +
  • Decoding_error for decoder errors (unlikely, probably a bug)
    • +
  • Encoding_error for encoder errors (unlikely, probably a bug)
    • +
+
+
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
  • LDAP_Failure for all results other than `SUCCESS (except referrals)
    • +
  • Decoding_error for decoder errors (unlikely, probably a bug)
    • +
  • Encoding_error for encoder errors (unlikely, probably a bug)
    • +
+
+
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
  • LDAP_Failure for all results other than `SUCCESS
    • +
  • Decoding_error for decoder errors (unlikely, probably a bug)
    • +
  • Encoding_error for encoder errors (unlikely, probably a bug)
    • +
+
+
val delete_s : conn -> dn:string -> unit
+delete the entry named by dn from the directory
+Raises
  • LDAP_Failure for all results other than `SUCCESS
    • +
  • Decoding_error for decoder errors (unlikely, probably a bug)
    • +
  • 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
+apply the list of modifications to the named entry
+Raises
  • LDAP_Failure for all results other than `SUCCESS
    • +
  • Decoding_error for decoder errors (unlikely, probably a bug)
    • +
  • Encoding_error for encoder errors (unlikely, probably a bug)
    • +
+
+
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
  • LDAP_Failure for all results other than `SUCCESS
    • +
  • Decoding_error for decoder errors (unlikely, probably a bug)
    • +
  • Encoding_error for encoder errors (unlikely, probably a bug)
    • +
+
+
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
+ \ No newline at end of file diff --git a/doc/ocamldap/html/Ldap_funserver.html b/doc/ocamldap/html/Ldap_funserver.html new file mode 100644 index 0000000..6b0d7b8 --- /dev/null +++ b/doc/ocamldap/html/Ldap_funserver.html @@ -0,0 +1,168 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +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.
+
+ \ No newline at end of file diff --git a/doc/ocamldap/html/Ldap_mutex.html b/doc/ocamldap/html/Ldap_mutex.html new file mode 100644 index 0000000..409bd06 --- /dev/null +++ b/doc/ocamldap/html/Ldap_mutex.html @@ -0,0 +1,77 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +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 +
+ \ No newline at end of file diff --git a/doc/ocamldap/html/Ldap_mutex.mutex.html b/doc/ocamldap/html/Ldap_mutex.mutex.html new file mode 100644 index 0000000..3c9d7b7 --- /dev/null +++ b/doc/ocamldap/html/Ldap_mutex.mutex.html @@ -0,0 +1,44 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + + +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
\ No newline at end of file diff --git a/doc/ocamldap/html/Ldap_mutex.mutex_t.html b/doc/ocamldap/html/Ldap_mutex.mutex_t.html new file mode 100644 index 0000000..3aaf403 --- /dev/null +++ b/doc/ocamldap/html/Ldap_mutex.mutex_t.html @@ -0,0 +1,40 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + + +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
\ No newline at end of file diff --git a/doc/ocamldap/html/Ldap_mutex.object_lock_table.html b/doc/ocamldap/html/Ldap_mutex.object_lock_table.html new file mode 100644 index 0000000..0189290 --- /dev/null +++ b/doc/ocamldap/html/Ldap_mutex.object_lock_table.html @@ -0,0 +1,44 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + + +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
\ No newline at end of file diff --git a/doc/ocamldap/html/Ldap_mutex.object_lock_table_t.html b/doc/ocamldap/html/Ldap_mutex.object_lock_table_t.html new file mode 100644 index 0000000..386ffee --- /dev/null +++ b/doc/ocamldap/html/Ldap_mutex.object_lock_table_t.html @@ -0,0 +1,40 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + + +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
\ No newline at end of file diff --git a/doc/ocamldap/html/Ldap_ooclient.OrdOid.html b/doc/ocamldap/html/Ldap_ooclient.OrdOid.html new file mode 100644 index 0000000..efae3bd --- /dev/null +++ b/doc/ocamldap/html/Ldap_ooclient.OrdOid.html @@ -0,0 +1,41 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + + +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
\ No newline at end of file diff --git a/doc/ocamldap/html/Ldap_ooclient.OrdStr.html b/doc/ocamldap/html/Ldap_ooclient.OrdStr.html new file mode 100644 index 0000000..ecb0cf9 --- /dev/null +++ b/doc/ocamldap/html/Ldap_ooclient.OrdStr.html @@ -0,0 +1,33 @@ + + + + + + + + + + + + + + + + + + + + + +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
\ No newline at end of file diff --git a/doc/ocamldap/html/Ldap_ooclient.Setstr.html b/doc/ocamldap/html/Ldap_ooclient.Setstr.html new file mode 100644 index 0000000..71076f7 --- /dev/null +++ b/doc/ocamldap/html/Ldap_ooclient.Setstr.html @@ -0,0 +1,44 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + + +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
\ No newline at end of file diff --git a/doc/ocamldap/html/Ldap_ooclient.html b/doc/ocamldap/html/Ldap_ooclient.html new file mode 100644 index 0000000..87f2869 --- /dev/null +++ b/doc/ocamldap/html/Ldap_ooclient.html @@ -0,0 +1,363 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +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
\ No newline at end of file diff --git a/doc/ocamldap/html/Ldap_ooclient.ldapaccount.html b/doc/ocamldap/html/Ldap_ooclient.ldapaccount.html new file mode 100644 index 0000000..a0966c8 --- /dev/null +++ b/doc/ocamldap/html/Ldap_ooclient.ldapaccount.html @@ -0,0 +1,87 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +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
\ No newline at end of file diff --git a/doc/ocamldap/html/Ldap_ooclient.ldapadvisorytxcon.html b/doc/ocamldap/html/Ldap_ooclient.ldapadvisorytxcon.html new file mode 100644 index 0000000..46dc727 --- /dev/null +++ b/doc/ocamldap/html/Ldap_ooclient.ldapadvisorytxcon.html @@ -0,0 +1,62 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + + +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
\ No newline at end of file diff --git a/doc/ocamldap/html/Ldap_ooclient.ldapcon.html b/doc/ocamldap/html/Ldap_ooclient.ldapcon.html new file mode 100644 index 0000000..e7001ae --- /dev/null +++ b/doc/ocamldap/html/Ldap_ooclient.ldapcon.html @@ -0,0 +1,200 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +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.
+ \ No newline at end of file diff --git a/doc/ocamldap/html/Ldap_ooclient.ldapentry.html b/doc/ocamldap/html/Ldap_ooclient.ldapentry.html new file mode 100644 index 0000000..f1a90de --- /dev/null +++ b/doc/ocamldap/html/Ldap_ooclient.ldapentry.html @@ -0,0 +1,103 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + + +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
+
+ \ No newline at end of file diff --git a/doc/ocamldap/html/Ldap_ooclient.ldapentry_t.html b/doc/ocamldap/html/Ldap_ooclient.ldapentry_t.html new file mode 100644 index 0000000..7eb4fb9 --- /dev/null +++ b/doc/ocamldap/html/Ldap_ooclient.ldapentry_t.html @@ -0,0 +1,37 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + +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
\ No newline at end of file diff --git a/doc/ocamldap/html/Ldap_ooclient.mutex.html b/doc/ocamldap/html/Ldap_ooclient.mutex.html new file mode 100644 index 0000000..f2c1221 --- /dev/null +++ b/doc/ocamldap/html/Ldap_ooclient.mutex.html @@ -0,0 +1,45 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + + +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
\ No newline at end of file diff --git a/doc/ocamldap/html/Ldap_ooclient.mutex_t.html b/doc/ocamldap/html/Ldap_ooclient.mutex_t.html new file mode 100644 index 0000000..9a20f2f --- /dev/null +++ b/doc/ocamldap/html/Ldap_ooclient.mutex_t.html @@ -0,0 +1,41 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + + +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
\ No newline at end of file diff --git a/doc/ocamldap/html/Ldap_ooclient.object_lock_table.html b/doc/ocamldap/html/Ldap_ooclient.object_lock_table.html new file mode 100644 index 0000000..d64ac00 --- /dev/null +++ b/doc/ocamldap/html/Ldap_ooclient.object_lock_table.html @@ -0,0 +1,45 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + + +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
\ No newline at end of file diff --git a/doc/ocamldap/html/Ldap_ooclient.object_lock_table_t.html b/doc/ocamldap/html/Ldap_ooclient.object_lock_table_t.html new file mode 100644 index 0000000..2e14ce4 --- /dev/null +++ b/doc/ocamldap/html/Ldap_ooclient.object_lock_table_t.html @@ -0,0 +1,39 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + +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
\ No newline at end of file diff --git a/doc/ocamldap/html/Ldap_ooclient.scldapentry.html b/doc/ocamldap/html/Ldap_ooclient.scldapentry.html new file mode 100644 index 0000000..c85111f --- /dev/null +++ b/doc/ocamldap/html/Ldap_ooclient.scldapentry.html @@ -0,0 +1,136 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +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
+
+ \ No newline at end of file diff --git a/doc/ocamldap/html/Ldap_protocol.html b/doc/ocamldap/html/Ldap_protocol.html new file mode 100644 index 0000000..2164592 --- /dev/null +++ b/doc/ocamldap/html/Ldap_protocol.html @@ -0,0 +1,58 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +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
+
+ \ No newline at end of file diff --git a/doc/ocamldap/html/Ldap_schemaparser.Lcstring.html b/doc/ocamldap/html/Ldap_schemaparser.Lcstring.html new file mode 100644 index 0000000..f8e7265 --- /dev/null +++ b/doc/ocamldap/html/Ldap_schemaparser.Lcstring.html @@ -0,0 +1,40 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + + +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
\ No newline at end of file diff --git a/doc/ocamldap/html/Ldap_schemaparser.Oid.html b/doc/ocamldap/html/Ldap_schemaparser.Oid.html new file mode 100644 index 0000000..c50ce86 --- /dev/null +++ b/doc/ocamldap/html/Ldap_schemaparser.Oid.html @@ -0,0 +1,40 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + + +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
\ No newline at end of file diff --git a/doc/ocamldap/html/Ldap_schemaparser.html b/doc/ocamldap/html/Ldap_schemaparser.html new file mode 100644 index 0000000..8de2d29 --- /dev/null +++ b/doc/ocamldap/html/Ldap_schemaparser.html @@ -0,0 +1,310 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +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.
+
+ \ No newline at end of file diff --git a/doc/ocamldap/html/Ldap_toplevel.html b/doc/ocamldap/html/Ldap_toplevel.html new file mode 100644 index 0000000..f8e88dc --- /dev/null +++ b/doc/ocamldap/html/Ldap_toplevel.html @@ -0,0 +1,65 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +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
+ \ No newline at end of file diff --git a/doc/ocamldap/html/Ldap_txooclient.html b/doc/ocamldap/html/Ldap_txooclient.html new file mode 100644 index 0000000..823f94a --- /dev/null +++ b/doc/ocamldap/html/Ldap_txooclient.html @@ -0,0 +1,58 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + + +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. +
+ \ No newline at end of file diff --git a/doc/ocamldap/html/Ldap_txooclient.ldapadvisorytxcon.html b/doc/ocamldap/html/Ldap_txooclient.ldapadvisorytxcon.html new file mode 100644 index 0000000..90d2c53 --- /dev/null +++ b/doc/ocamldap/html/Ldap_txooclient.ldapadvisorytxcon.html @@ -0,0 +1,59 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + +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
\ No newline at end of file diff --git a/doc/ocamldap/html/Ldap_types.html b/doc/ocamldap/html/Ldap_types.html new file mode 100644 index 0000000..2c55560 --- /dev/null +++ b/doc/ocamldap/html/Ldap_types.html @@ -0,0 +1,807 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +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
+
+ + \ No newline at end of file diff --git a/doc/ocamldap/html/Ldap_url.html b/doc/ocamldap/html/Ldap_url.html new file mode 100644 index 0000000..a5e9b61 --- /dev/null +++ b/doc/ocamldap/html/Ldap_url.html @@ -0,0 +1,52 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +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
+
+ \ No newline at end of file diff --git a/doc/ocamldap/html/Ldif_changerec_oo.change.html b/doc/ocamldap/html/Ldif_changerec_oo.change.html new file mode 100644 index 0000000..44c92c1 --- /dev/null +++ b/doc/ocamldap/html/Ldif_changerec_oo.change.html @@ -0,0 +1,36 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + +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
\ No newline at end of file diff --git a/doc/ocamldap/html/Ldif_changerec_oo.html b/doc/ocamldap/html/Ldif_changerec_oo.html new file mode 100644 index 0000000..4150e7d --- /dev/null +++ b/doc/ocamldap/html/Ldif_changerec_oo.html @@ -0,0 +1,57 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +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
\ No newline at end of file diff --git a/doc/ocamldap/html/Ldif_oo.html b/doc/ocamldap/html/Ldif_oo.html new file mode 100644 index 0000000..87111db --- /dev/null +++ b/doc/ocamldap/html/Ldif_oo.html @@ -0,0 +1,61 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +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
\ No newline at end of file diff --git a/doc/ocamldap/html/Ldif_oo.ldif.html b/doc/ocamldap/html/Ldif_oo.ldif.html new file mode 100644 index 0000000..351be94 --- /dev/null +++ b/doc/ocamldap/html/Ldif_oo.ldif.html @@ -0,0 +1,36 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + +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
\ No newline at end of file diff --git a/doc/ocamldap/html/index.html b/doc/ocamldap/html/index.html new file mode 100644 index 0000000..233c03b --- /dev/null +++ b/doc/ocamldap/html/index.html @@ -0,0 +1,109 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +

+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 +
+
+ + \ No newline at end of file diff --git a/doc/ocamldap/html/index_attributes.html b/doc/ocamldap/html/index_attributes.html new file mode 100644 index 0000000..5230c25 --- /dev/null +++ b/doc/ocamldap/html/index_attributes.html @@ -0,0 +1,34 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + +Index of class attributes + + +

Index of class attributes

+ +

+ + \ No newline at end of file diff --git a/doc/ocamldap/html/index_class_types.html b/doc/ocamldap/html/index_class_types.html new file mode 100644 index 0000000..53f9a11 --- /dev/null +++ b/doc/ocamldap/html/index_class_types.html @@ -0,0 +1,54 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + +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 +
+

+ + \ No newline at end of file diff --git a/doc/ocamldap/html/index_classes.html b/doc/ocamldap/html/index_classes.html new file mode 100644 index 0000000..6e5831d --- /dev/null +++ b/doc/ocamldap/html/index_classes.html @@ -0,0 +1,75 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + +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]

+ + \ No newline at end of file diff --git a/doc/ocamldap/html/index_exceptions.html b/doc/ocamldap/html/index_exceptions.html new file mode 100644 index 0000000..bb8069d --- /dev/null +++ b/doc/ocamldap/html/index_exceptions.html @@ -0,0 +1,167 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + +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 +
+

+ + \ No newline at end of file diff --git a/doc/ocamldap/html/index_methods.html b/doc/ocamldap/html/index_methods.html new file mode 100644 index 0000000..a3d78b7 --- /dev/null +++ b/doc/ocamldap/html/index_methods.html @@ -0,0 +1,517 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + +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]

+ + \ No newline at end of file diff --git a/doc/ocamldap/html/index_module_types.html b/doc/ocamldap/html/index_module_types.html new file mode 100644 index 0000000..27d129e --- /dev/null +++ b/doc/ocamldap/html/index_module_types.html @@ -0,0 +1,34 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + +Index of module types + + +

Index of module types

+ +

+ + \ No newline at end of file diff --git a/doc/ocamldap/html/index_modules.html b/doc/ocamldap/html/index_modules.html new file mode 100644 index 0000000..d7a7532 --- /dev/null +++ b/doc/ocamldap/html/index_modules.html @@ -0,0 +1,134 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + +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 +
+

+ + \ No newline at end of file diff --git a/doc/ocamldap/html/index_types.html b/doc/ocamldap/html/index_types.html new file mode 100644 index 0000000..14e372d --- /dev/null +++ b/doc/ocamldap/html/index_types.html @@ -0,0 +1,247 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + +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]

+ + \ No newline at end of file diff --git a/doc/ocamldap/html/index_values.html b/doc/ocamldap/html/index_values.html new file mode 100644 index 0000000..e664e48 --- /dev/null +++ b/doc/ocamldap/html/index_values.html @@ -0,0 +1,528 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + +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 +
+

+ + \ No newline at end of file diff --git a/doc/ocamldap/html/style.css b/doc/ocamldap/html/style.css new file mode 100644 index 0000000..c0a80f3 --- /dev/null +++ b/doc/ocamldap/html/style.css @@ -0,0 +1,33 @@ +a: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} \ No newline at end of file diff --git a/doc/ocamldap/html/type_Lber.html b/doc/ocamldap/html/type_Lber.html new file mode 100644 index 0000000..682f50e --- /dev/null +++ b/doc/ocamldap/html/type_Lber.html @@ -0,0 +1,88 @@ + + + + + + + + + + + + + + + + + + + + + + + + + +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
+end \ No newline at end of file diff --git a/doc/ocamldap/html/type_Ldap_dn.html b/doc/ocamldap/html/type_Ldap_dn.html new file mode 100644 index 0000000..c4766e1 --- /dev/null +++ b/doc/ocamldap/html/type_Ldap_dn.html @@ -0,0 +1,35 @@ + + + + + + + + + + + + + + + + + + + + + + + + + +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
+end \ No newline at end of file diff --git a/doc/ocamldap/html/type_Ldap_error.html b/doc/ocamldap/html/type_Ldap_error.html new file mode 100644 index 0000000..cf3cd63 --- /dev/null +++ b/doc/ocamldap/html/type_Ldap_error.html @@ -0,0 +1,74 @@ + + + + + + + + + + + + + + + + + + + + + + + + + +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
+end \ No newline at end of file diff --git a/doc/ocamldap/html/type_Ldap_filter.html b/doc/ocamldap/html/type_Ldap_filter.html new file mode 100644 index 0000000..d3865a8 --- /dev/null +++ b/doc/ocamldap/html/type_Ldap_filter.html @@ -0,0 +1,34 @@ + + + + + + + + + + + + + + + + + + + + + + + + + +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
+end \ No newline at end of file diff --git a/doc/ocamldap/html/type_Ldap_funclient.html b/doc/ocamldap/html/type_Ldap_funclient.html new file mode 100644 index 0000000..757aa2a --- /dev/null +++ b/doc/ocamldap/html/type_Ldap_funclient.html @@ -0,0 +1,80 @@ + + + + + + + + + + + + + + + + + + + + + + + + + +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
+end \ No newline at end of file diff --git a/doc/ocamldap/html/type_Ldap_funserver.html b/doc/ocamldap/html/type_Ldap_funserver.html new file mode 100644 index 0000000..7e38fc3 --- /dev/null +++ b/doc/ocamldap/html/type_Ldap_funserver.html @@ -0,0 +1,81 @@ + + + + + + + + + + + + + + + + + + + + + + + + + +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
+end \ No newline at end of file diff --git a/doc/ocamldap/html/type_Ldap_mutex.html b/doc/ocamldap/html/type_Ldap_mutex.html new file mode 100644 index 0000000..f3c0617 --- /dev/null +++ b/doc/ocamldap/html/type_Ldap_mutex.html @@ -0,0 +1,51 @@ + + + + + + + + + + + + + + + + + + + + + + + + + +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
+end \ No newline at end of file diff --git a/doc/ocamldap/html/type_Ldap_mutex.mutex.html b/doc/ocamldap/html/type_Ldap_mutex.mutex.html new file mode 100644 index 0000000..f90e9d1 --- /dev/null +++ b/doc/ocamldap/html/type_Ldap_mutex.mutex.html @@ -0,0 +1,31 @@ + + + + + + + + + + + + + + + + + + + + + + + + + +Ldap_mutex.mutex + + +string list ->
+string ->
+string -> string -> object method lock : unit method unlock : unit end \ No newline at end of file diff --git a/doc/ocamldap/html/type_Ldap_mutex.mutex_t.html b/doc/ocamldap/html/type_Ldap_mutex.mutex_t.html new file mode 100644 index 0000000..532860e --- /dev/null +++ b/doc/ocamldap/html/type_Ldap_mutex.mutex_t.html @@ -0,0 +1,29 @@ + + + + + + + + + + + + + + + + + + + + + + + + + +Ldap_mutex.mutex_t + + +object method lock : unit method unlock : unit end \ No newline at end of file diff --git a/doc/ocamldap/html/type_Ldap_mutex.object_lock_table.html b/doc/ocamldap/html/type_Ldap_mutex.object_lock_table.html new file mode 100644 index 0000000..d9a936e --- /dev/null +++ b/doc/ocamldap/html/type_Ldap_mutex.object_lock_table.html @@ -0,0 +1,36 @@ + + + + + + + + + + + + + + + + + + + + + + + + + +Ldap_mutex.object_lock_table + + +string list ->
+string ->
+string ->
+string ->
+object
+  method lock : Ldap_types.dn -> unit
+  method unlock : Ldap_types.dn -> unit
+end \ No newline at end of file diff --git a/doc/ocamldap/html/type_Ldap_mutex.object_lock_table_t.html b/doc/ocamldap/html/type_Ldap_mutex.object_lock_table_t.html new file mode 100644 index 0000000..0c68a8b --- /dev/null +++ b/doc/ocamldap/html/type_Ldap_mutex.object_lock_table_t.html @@ -0,0 +1,32 @@ + + + + + + + + + + + + + + + + + + + + + + + + + +Ldap_mutex.object_lock_table_t + + +object
+  method lock : Ldap_types.dn -> unit
+  method unlock : Ldap_types.dn -> unit
+end \ No newline at end of file diff --git a/doc/ocamldap/html/type_Ldap_ooclient.OrdOid.html b/doc/ocamldap/html/type_Ldap_ooclient.OrdOid.html new file mode 100644 index 0000000..39af77a --- /dev/null +++ b/doc/ocamldap/html/type_Ldap_ooclient.OrdOid.html @@ -0,0 +1,32 @@ + + + + + + + + + + + + + + + + + + + + + + + + + +Ldap_ooclient.OrdOid + + +sig
+  type t = Ldap_schemaparser.Oid.t
+  val compare : Ldap_ooclient.OrdOid.t -> Ldap_ooclient.OrdOid.t -> int
+end \ No newline at end of file diff --git a/doc/ocamldap/html/type_Ldap_ooclient.OrdStr.html b/doc/ocamldap/html/type_Ldap_ooclient.OrdStr.html new file mode 100644 index 0000000..511e311 --- /dev/null +++ b/doc/ocamldap/html/type_Ldap_ooclient.OrdStr.html @@ -0,0 +1,25 @@ + + + + + + + + + + + + + + + + + + +Ldap_ooclient.OrdStr + + +sig
+  type t = Ldap_schemaparser.Oid.t
+  val compare : Ldap_schemaparser.Oid.t -> Ldap_schemaparser.Oid.t -> int
+end \ No newline at end of file diff --git a/doc/ocamldap/html/type_Ldap_ooclient.Setstr.html b/doc/ocamldap/html/type_Ldap_ooclient.Setstr.html new file mode 100644 index 0000000..d90a89e --- /dev/null +++ b/doc/ocamldap/html/type_Ldap_ooclient.Setstr.html @@ -0,0 +1,78 @@ + + + + + + + + + + + + + + + + + + + + + + + + + +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
+end \ No newline at end of file diff --git a/doc/ocamldap/html/type_Ldap_ooclient.html b/doc/ocamldap/html/type_Ldap_ooclient.html new file mode 100644 index 0000000..28bb3ba --- /dev/null +++ b/doc/ocamldap/html/type_Ldap_ooclient.html @@ -0,0 +1,310 @@ + + + + + + + + + + + + + + + + + + + + + + + + + +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
+end \ No newline at end of file diff --git a/doc/ocamldap/html/type_Ldap_ooclient.ldapaccount.html b/doc/ocamldap/html/type_Ldap_ooclient.ldapaccount.html new file mode 100644 index 0000000..32fcfb7 --- /dev/null +++ b/doc/ocamldap/html/type_Ldap_ooclient.ldapaccount.html @@ -0,0 +1,66 @@ + + + + + + + + + + + + + + + + + + + + + + + + + +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
+end \ No newline at end of file diff --git a/doc/ocamldap/html/type_Ldap_ooclient.ldapadvisorytxcon.html b/doc/ocamldap/html/type_Ldap_ooclient.ldapadvisorytxcon.html new file mode 100644 index 0000000..ddff39a --- /dev/null +++ b/doc/ocamldap/html/type_Ldap_ooclient.ldapadvisorytxcon.html @@ -0,0 +1,69 @@ + + + + + + + + + + + + + + + + + + + + + + + + +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
+end \ No newline at end of file diff --git a/doc/ocamldap/html/type_Ldap_ooclient.ldapcon.html b/doc/ocamldap/html/type_Ldap_ooclient.ldapcon.html new file mode 100644 index 0000000..6c56618 --- /dev/null +++ b/doc/ocamldap/html/type_Ldap_ooclient.ldapcon.html @@ -0,0 +1,61 @@ + + + + + + + + + + + + + + + + + + + + + + + + + +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
+end \ No newline at end of file diff --git a/doc/ocamldap/html/type_Ldap_ooclient.ldapentry.html b/doc/ocamldap/html/type_Ldap_ooclient.ldapentry.html new file mode 100644 index 0000000..9b1b2c8 --- /dev/null +++ b/doc/ocamldap/html/type_Ldap_ooclient.ldapentry.html @@ -0,0 +1,48 @@ + + + + + + + + + + + + + + + + + + + + + + + + + +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
+end \ No newline at end of file diff --git a/doc/ocamldap/html/type_Ldap_ooclient.ldapentry_t.html b/doc/ocamldap/html/type_Ldap_ooclient.ldapentry_t.html new file mode 100644 index 0000000..4050539 --- /dev/null +++ b/doc/ocamldap/html/type_Ldap_ooclient.ldapentry_t.html @@ -0,0 +1,48 @@ + + + + + + + + + + + + + + + + + + + + + + + + + +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
+end \ No newline at end of file diff --git a/doc/ocamldap/html/type_Ldap_ooclient.mutex.html b/doc/ocamldap/html/type_Ldap_ooclient.mutex.html new file mode 100644 index 0000000..28b8900 --- /dev/null +++ b/doc/ocamldap/html/type_Ldap_ooclient.mutex.html @@ -0,0 +1,30 @@ + + + + + + + + + + + + + + + + + + + + + + + + +Ldap_ooclient.mutex + + +string list ->
+string ->
+string -> string -> object method lock : unit method unlock : unit end \ No newline at end of file diff --git a/doc/ocamldap/html/type_Ldap_ooclient.mutex_t.html b/doc/ocamldap/html/type_Ldap_ooclient.mutex_t.html new file mode 100644 index 0000000..73a3f6a --- /dev/null +++ b/doc/ocamldap/html/type_Ldap_ooclient.mutex_t.html @@ -0,0 +1,28 @@ + + + + + + + + + + + + + + + + + + + + + + + + +Ldap_ooclient.mutex_t + + +object method lock : unit method unlock : unit end \ No newline at end of file diff --git a/doc/ocamldap/html/type_Ldap_ooclient.object_lock_table.html b/doc/ocamldap/html/type_Ldap_ooclient.object_lock_table.html new file mode 100644 index 0000000..268b4f2 --- /dev/null +++ b/doc/ocamldap/html/type_Ldap_ooclient.object_lock_table.html @@ -0,0 +1,35 @@ + + + + + + + + + + + + + + + + + + + + + + + + +Ldap_ooclient.object_lock_table + + +string list ->
+string ->
+string ->
+string ->
+object
+  method lock : Ldap_types.dn -> unit
+  method unlock : Ldap_types.dn -> unit
+end \ No newline at end of file diff --git a/doc/ocamldap/html/type_Ldap_ooclient.object_lock_table_t.html b/doc/ocamldap/html/type_Ldap_ooclient.object_lock_table_t.html new file mode 100644 index 0000000..319fc91 --- /dev/null +++ b/doc/ocamldap/html/type_Ldap_ooclient.object_lock_table_t.html @@ -0,0 +1,31 @@ + + + + + + + + + + + + + + + + + + + + + + + + +Ldap_ooclient.object_lock_table_t + + +object
+  method lock : Ldap_types.dn -> unit
+  method unlock : Ldap_types.dn -> unit
+end \ No newline at end of file diff --git a/doc/ocamldap/html/type_Ldap_ooclient.scldapentry.html b/doc/ocamldap/html/type_Ldap_ooclient.scldapentry.html new file mode 100644 index 0000000..4ca3017 --- /dev/null +++ b/doc/ocamldap/html/type_Ldap_ooclient.scldapentry.html @@ -0,0 +1,56 @@ + + + + + + + + + + + + + + + + + + + + + + + + + +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
+end \ No newline at end of file diff --git a/doc/ocamldap/html/type_Ldap_protocol.html b/doc/ocamldap/html/type_Ldap_protocol.html new file mode 100644 index 0000000..ebc0dc1 --- /dev/null +++ b/doc/ocamldap/html/type_Ldap_protocol.html @@ -0,0 +1,34 @@ + + + + + + + + + + + + + + + + + + + + + + + + + +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
+end \ No newline at end of file diff --git a/doc/ocamldap/html/type_Ldap_schemaparser.Lcstring.html b/doc/ocamldap/html/type_Ldap_schemaparser.Lcstring.html new file mode 100644 index 0000000..f683c13 --- /dev/null +++ b/doc/ocamldap/html/type_Ldap_schemaparser.Lcstring.html @@ -0,0 +1,35 @@ + + + + + + + + + + + + + + + + + + + + + + + + + +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
+end \ No newline at end of file diff --git a/doc/ocamldap/html/type_Ldap_schemaparser.Oid.html b/doc/ocamldap/html/type_Ldap_schemaparser.Oid.html new file mode 100644 index 0000000..dacbe5d --- /dev/null +++ b/doc/ocamldap/html/type_Ldap_schemaparser.Oid.html @@ -0,0 +1,34 @@ + + + + + + + + + + + + + + + + + + + + + + + + + +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
+end \ No newline at end of file diff --git a/doc/ocamldap/html/type_Ldap_schemaparser.html b/doc/ocamldap/html/type_Ldap_schemaparser.html new file mode 100644 index 0000000..8669067 --- /dev/null +++ b/doc/ocamldap/html/type_Ldap_schemaparser.html @@ -0,0 +1,97 @@ + + + + + + + + + + + + + + + + + + + + + + + + + +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
+end \ No newline at end of file diff --git a/doc/ocamldap/html/type_Ldap_toplevel.html b/doc/ocamldap/html/type_Ldap_toplevel.html new file mode 100644 index 0000000..a10a8a4 --- /dev/null +++ b/doc/ocamldap/html/type_Ldap_toplevel.html @@ -0,0 +1,44 @@ + + + + + + + + + + + + + + + + + + + + + + + + + +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
+end \ No newline at end of file diff --git a/doc/ocamldap/html/type_Ldap_txooclient.html b/doc/ocamldap/html/type_Ldap_txooclient.html new file mode 100644 index 0000000..c41759e --- /dev/null +++ b/doc/ocamldap/html/type_Ldap_txooclient.html @@ -0,0 +1,84 @@ + + + + + + + + + + + + + + + + + + + + + + + + + +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
+end \ No newline at end of file diff --git a/doc/ocamldap/html/type_Ldap_txooclient.ldapadvisorytxcon.html b/doc/ocamldap/html/type_Ldap_txooclient.ldapadvisorytxcon.html new file mode 100644 index 0000000..fb069ec --- /dev/null +++ b/doc/ocamldap/html/type_Ldap_txooclient.ldapadvisorytxcon.html @@ -0,0 +1,75 @@ + + + + + + + + + + + + + + + + + + + + + + + + + +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
+end \ No newline at end of file diff --git a/doc/ocamldap/html/type_Ldap_types.html b/doc/ocamldap/html/type_Ldap_types.html new file mode 100644 index 0000000..4fee361 --- /dev/null +++ b/doc/ocamldap/html/type_Ldap_types.html @@ -0,0 +1,242 @@ + + + + + + + + + + + + + + + + + + + + + + + + + +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
+end \ No newline at end of file diff --git a/doc/ocamldap/html/type_Ldap_url.html b/doc/ocamldap/html/type_Ldap_url.html new file mode 100644 index 0000000..9925fff --- /dev/null +++ b/doc/ocamldap/html/type_Ldap_url.html @@ -0,0 +1,32 @@ + + + + + + + + + + + + + + + + + + + + + + + + + +Ldap_url + + +sig
+  exception Invalid_ldap_url of int * string
+  val of_string : string -> Ldap_types.ldap_url
+end \ No newline at end of file diff --git a/doc/ocamldap/html/type_Ldif_changerec_oo.change.html b/doc/ocamldap/html/type_Ldif_changerec_oo.change.html new file mode 100644 index 0000000..1613c32 --- /dev/null +++ b/doc/ocamldap/html/type_Ldif_changerec_oo.change.html @@ -0,0 +1,37 @@ + + + + + + + + + + + + + + + + + + + + + + + + + +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
+end \ No newline at end of file diff --git a/doc/ocamldap/html/type_Ldif_changerec_oo.html b/doc/ocamldap/html/type_Ldif_changerec_oo.html new file mode 100644 index 0000000..81391a9 --- /dev/null +++ b/doc/ocamldap/html/type_Ldif_changerec_oo.html @@ -0,0 +1,44 @@ + + + + + + + + + + + + + + + + + + + + + + + + + +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
+end \ No newline at end of file diff --git a/doc/ocamldap/html/type_Ldif_oo.html b/doc/ocamldap/html/type_Ldif_oo.html new file mode 100644 index 0000000..b8e6202 --- /dev/null +++ b/doc/ocamldap/html/type_Ldif_oo.html @@ -0,0 +1,50 @@ + + + + + + + + + + + + + + + + + + + + + + + + + +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
+end \ No newline at end of file diff --git a/doc/ocamldap/html/type_Ldif_oo.ldif.html b/doc/ocamldap/html/type_Ldif_oo.ldif.html new file mode 100644 index 0000000..1c12017 --- /dev/null +++ b/doc/ocamldap/html/type_Ldif_oo.ldif.html @@ -0,0 +1,37 @@ + + + + + + + + + + + + + + + + + + + + + + + + + +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
+end \ No newline at end of file diff --git a/lber.ml b/lber.ml new file mode 100644 index 0000000..37d3ce0 --- /dev/null +++ b/lber.ml @@ -0,0 +1,680 @@ +(* 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 diff --git a/lber.mli b/lber.mli new file mode 100644 index 0000000..d02dd9f --- /dev/null +++ b/lber.mli @@ -0,0 +1,150 @@ +(* 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 diff --git a/lber_tests.ml b/lber_tests.ml new file mode 100644 index 0000000..5f76fe2 --- /dev/null +++ b/lber_tests.ml @@ -0,0 +1,49 @@ +open 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 () diff --git a/ldap_dn.ml b/ldap_dn.ml new file mode 100644 index 0000000..346e6e5 --- /dev/null +++ b/ldap_dn.ml @@ -0,0 +1,133 @@ +(* 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)) diff --git a/ldap_dn.mli b/ldap_dn.mli new file mode 100644 index 0000000..6ff401e --- /dev/null +++ b/ldap_dn.mli @@ -0,0 +1,53 @@ +(* 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 diff --git a/ldap_dnlexer.mll b/ldap_dnlexer.mll new file mode 100644 index 0000000..11450df --- /dev/null +++ b/ldap_dnlexer.mll @@ -0,0 +1,56 @@ +(* 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} diff --git a/ldap_dnparser.mly b/ldap_dnparser.mly new file mode 100644 index 0000000..90552b4 --- /dev/null +++ b/ldap_dnparser.mly @@ -0,0 +1,127 @@ +/* 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 {[]} +; diff --git a/ldap_error.ml b/ldap_error.ml new file mode 100644 index 0000000..57e8239 --- /dev/null +++ b/ldap_error.ml @@ -0,0 +1,64 @@ +open 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) diff --git a/ldap_error.mli b/ldap_error.mli new file mode 100644 index 0000000..cbbc99f --- /dev/null +++ b/ldap_error.mli @@ -0,0 +1,51 @@ +open 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 diff --git a/ldap_filter.ml b/ldap_filter.ml new file mode 100644 index 0000000..cf4204a --- /dev/null +++ b/ldap_filter.ml @@ -0,0 +1,163 @@ +(* 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 + diff --git a/ldap_filter.mli b/ldap_filter.mli new file mode 100644 index 0000000..14639f5 --- /dev/null +++ b/ldap_filter.mli @@ -0,0 +1,47 @@ +(** 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 diff --git a/ldap_filterlexer.mll b/ldap_filterlexer.mll new file mode 100644 index 0000000..f0b21de --- /dev/null +++ b/ldap_filterlexer.mll @@ -0,0 +1,100 @@ +(* 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} diff --git a/ldap_filterparser.mly b/ldap_filterparser.mly new file mode 100644 index 0000000..dea42cb --- /dev/null +++ b/ldap_filterparser.mly @@ -0,0 +1,87 @@ +/* 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} +; diff --git a/ldap_funclient.ml b/ldap_funclient.ml new file mode 100644 index 0000000..a6d2925 --- /dev/null +++ b/ldap_funclient.ml @@ -0,0 +1,389 @@ +(* 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 = () diff --git a/ldap_funclient.mli b/ldap_funclient.mli new file mode 100644 index 0000000..8843446 --- /dev/null +++ b/ldap_funclient.mli @@ -0,0 +1,197 @@ +(* 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 diff --git a/ldap_funserver.ml b/ldap_funserver.ml new file mode 100644 index 0000000..e79cbf8 --- /dev/null +++ b/ldap_funserver.ml @@ -0,0 +1,401 @@ +(* + 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 diff --git a/ldap_funserver.mli b/ldap_funserver.mli new file mode 100644 index 0000000..77b3933 --- /dev/null +++ b/ldap_funserver.mli @@ -0,0 +1,79 @@ +(* + 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 diff --git a/ldap_mutex.ml b/ldap_mutex.ml new file mode 100644 index 0000000..63a4e31 --- /dev/null +++ b/ldap_mutex.ml @@ -0,0 +1,116 @@ +open 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 diff --git a/ldap_mutex.mli b/ldap_mutex.mli new file mode 100644 index 0000000..4824e72 --- /dev/null +++ b/ldap_mutex.mli @@ -0,0 +1,51 @@ +open 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 diff --git a/ldap_ooclient.ml b/ldap_ooclient.ml new file mode 100644 index 0000000..fd8b487 --- /dev/null +++ b/ldap_ooclient.ml @@ -0,0 +1,1310 @@ + (* 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;; diff --git a/ldap_ooclient.mli b/ldap_ooclient.mli new file mode 100644 index 0000000..b88ec16 --- /dev/null +++ b/ldap_ooclient.mli @@ -0,0 +1,730 @@ +(* 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 diff --git a/ldap_protocol.ml b/ldap_protocol.ml new file mode 100644 index 0000000..9a2db56 --- /dev/null +++ b/ldap_protocol.ml @@ -0,0 +1,1125 @@ +(* 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") diff --git a/ldap_protocol.mli b/ldap_protocol.mli new file mode 100644 index 0000000..41c3184 --- /dev/null +++ b/ldap_protocol.mli @@ -0,0 +1,42 @@ +(* 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 diff --git a/ldap_schemalexer.mll b/ldap_schemalexer.mll new file mode 100644 index 0000000..e5e8abd --- /dev/null +++ b/ldap_schemalexer.mll @@ -0,0 +1,145 @@ +(* 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} diff --git a/ldap_schemaparser.ml b/ldap_schemaparser.ml new file mode 100644 index 0000000..78cfcd2 --- /dev/null +++ b/ldap_schemaparser.ml @@ -0,0 +1,324 @@ +(* 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;; diff --git a/ldap_schemaparser.mli b/ldap_schemaparser.mli new file mode 100644 index 0000000..0d29db7 --- /dev/null +++ b/ldap_schemaparser.mli @@ -0,0 +1,92 @@ +(** 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 diff --git a/ldap_toplevel.ml b/ldap_toplevel.ml new file mode 100644 index 0000000..f7b3d48 --- /dev/null +++ b/ldap_toplevel.ml @@ -0,0 +1,72 @@ +(* 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) +;; diff --git a/ldap_toplevel.mli b/ldap_toplevel.mli new file mode 100644 index 0000000..9b5a324 --- /dev/null +++ b/ldap_toplevel.mli @@ -0,0 +1,58 @@ +(* 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 diff --git a/ldap_txooclient.ml b/ldap_txooclient.ml new file mode 100644 index 0000000..622266f --- /dev/null +++ b/ldap_txooclient.ml @@ -0,0 +1,184 @@ +open 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 diff --git a/ldap_txooclient.mli b/ldap_txooclient.mli new file mode 100644 index 0000000..02c0c2e --- /dev/null +++ b/ldap_txooclient.mli @@ -0,0 +1,74 @@ +open 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 diff --git a/ldap_types.ml b/ldap_types.ml new file mode 100644 index 0000000..09853ae --- /dev/null +++ b/ldap_types.ml @@ -0,0 +1,303 @@ +(* 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 diff --git a/ldap_types.mli b/ldap_types.mli new file mode 100644 index 0000000..09853ae --- /dev/null +++ b/ldap_types.mli @@ -0,0 +1,303 @@ +(* 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 diff --git a/ldap_url.ml b/ldap_url.ml new file mode 100644 index 0000000..c194c01 --- /dev/null +++ b/ldap_url.ml @@ -0,0 +1,33 @@ +(* 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)) diff --git a/ldap_url.mli b/ldap_url.mli new file mode 100644 index 0000000..f66c98f --- /dev/null +++ b/ldap_url.mli @@ -0,0 +1,32 @@ +(* 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 diff --git a/ldap_urllexer.mll b/ldap_urllexer.mll new file mode 100644 index 0000000..43df2dd --- /dev/null +++ b/ldap_urllexer.mll @@ -0,0 +1,78 @@ +(* 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} +*) diff --git a/ldap_urlparser.cmi b/ldap_urlparser.cmi new file mode 100644 index 0000000..b75af0a Binary files /dev/null and b/ldap_urlparser.cmi differ diff --git a/ldap_urlparser.cmo b/ldap_urlparser.cmo new file mode 100644 index 0000000..b92f967 Binary files /dev/null and b/ldap_urlparser.cmo differ diff --git a/ldap_urlparser.mli b/ldap_urlparser.mli new file mode 100644 index 0000000..4d029dc --- /dev/null +++ b/ldap_urlparser.mli @@ -0,0 +1,19 @@ +type 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 diff --git a/ldif_changerec_lexer.mll b/ldif_changerec_lexer.mll new file mode 100644 index 0000000..2d7c689 --- /dev/null +++ b/ldif_changerec_lexer.mll @@ -0,0 +1,47 @@ +(* 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} diff --git a/ldif_changerec_oo.ml b/ldif_changerec_oo.ml new file mode 100644 index 0000000..8e07f8c --- /dev/null +++ b/ldif_changerec_oo.ml @@ -0,0 +1,94 @@ +(* 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 diff --git a/ldif_changerec_oo.mli b/ldif_changerec_oo.mli new file mode 100644 index 0000000..bc6a97e --- /dev/null +++ b/ldif_changerec_oo.mli @@ -0,0 +1,48 @@ +(* 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 diff --git a/ldif_changerec_parser.mly b/ldif_changerec_parser.mly new file mode 100644 index 0000000..4d5d173 --- /dev/null +++ b/ldif_changerec_parser.mly @@ -0,0 +1,101 @@ +/* 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"} +; diff --git a/ldif_oo.ml b/ldif_oo.ml new file mode 100644 index 0000000..69e4682 --- /dev/null +++ b/ldif_oo.ml @@ -0,0 +1,145 @@ +(* 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 diff --git a/ldif_oo.mli b/ldif_oo.mli new file mode 100644 index 0000000..d5c3c73 --- /dev/null +++ b/ldif_oo.mli @@ -0,0 +1,56 @@ +(* 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 diff --git a/ldif_parser.ml b/ldif_parser.ml new file mode 100644 index 0000000..00a3365 --- /dev/null +++ b/ldif_parser.ml @@ -0,0 +1,223 @@ +(* 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} diff --git a/mutex.schema b/mutex.schema new file mode 100644 index 0000000..cff73fe --- /dev/null +++ b/mutex.schema @@ -0,0 +1,35 @@ +# 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 ) ) diff --git a/test.ml b/test.ml new file mode 100644 index 0000000..c85c7bf --- /dev/null +++ b/test.ml @@ -0,0 +1,85 @@ +(* a test program for ldap_funclient + + 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: test.ml 198 2005-07-05 23:29:42Z gremlin43820 $ *) + +open Ldap_types +open Ldap_funclient +open Arg +open Printf + +let ldif_buffer = Buffer.create 3124 +let print_entry e = + match e with + `Entry {sr_dn=dn;sr_attributes=attrs} -> + 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 ();; + diff --git a/testldif.ml b/testldif.ml new file mode 100644 index 0000000..8522036 --- /dev/null +++ b/testldif.ml @@ -0,0 +1,30 @@ +(* 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 diff --git a/testoo.cmi b/testoo.cmi new file mode 100644 index 0000000..d043769 Binary files /dev/null and b/testoo.cmi differ diff --git a/testoo.ml b/testoo.ml new file mode 100644 index 0000000..51ac5ef --- /dev/null +++ b/testoo.ml @@ -0,0 +1,61 @@ +(* 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 diff --git a/ulist.ml b/ulist.ml new file mode 100644 index 0000000..14ac4a6 --- /dev/null +++ b/ulist.ml @@ -0,0 +1,35 @@ +(* 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 [];; -- cgit v1.2.3 From 2ce01485333941caa0a35098e2029addc5fbce78 Mon Sep 17 00:00:00 2001 From: Mehdi Dogguy Date: Sat, 17 Oct 2015 20:50:38 +0200 Subject: Import ocamldap_2.1.8-10.debian.tar.xz [dgit import tarball ocamldap 2.1.8-10 ocamldap_2.1.8-10.debian.tar.xz] --- changelog | 267 +++++++++++++++++++++ clean | 3 + compat | 1 + control | 38 +++ copyright | 30 +++ gbp.conf | 2 + libldap-ocaml-dev.dirs.in | 2 + libldap-ocaml-dev.examples | 3 + libldap-ocaml-dev.ocamldoc | 1 + ...ile-explictly-with-pcre-and-compiler-libs.patch | 23 ++ patches/0002-Use-Ldap_funclient.init.patch | 37 +++ patches/series | 2 + rules | 48 ++++ source/format | 1 + watch | 2 + 15 files changed, 460 insertions(+) create mode 100644 changelog create mode 100644 clean create mode 100644 compat create mode 100644 control create mode 100644 copyright create mode 100644 gbp.conf create mode 100644 libldap-ocaml-dev.dirs.in create mode 100644 libldap-ocaml-dev.examples create mode 100644 libldap-ocaml-dev.ocamldoc create mode 100644 patches/0001-Compile-explictly-with-pcre-and-compiler-libs.patch create mode 100644 patches/0002-Use-Ldap_funclient.init.patch create mode 100644 patches/series create mode 100755 rules create mode 100644 source/format create mode 100644 watch diff --git a/changelog b/changelog new file mode 100644 index 0000000..829a1e2 --- /dev/null +++ b/changelog @@ -0,0 +1,267 @@ +ocamldap (2.1.8-10) unstable; urgency=medium + + * Fix FTBFS with OCaml 4.02.3 + + -- Mehdi Dogguy Sat, 17 Oct 2015 20:50:38 +0200 + +ocamldap (2.1.8-9) unstable; urgency=low + + [ Stéphane Glondu ] + * Team upload + * Fix versioned build-deps to ensure smoother backports + * Compile explicitly with pcre and compiler-libs (Closes: #731405) + + [ Sylvain Le Gall ] + * Remove Sylvain Le Gall from uploaders + + -- Stéphane Glondu Sat, 07 Dec 2013 13:20:13 +0100 + +ocamldap (2.1.8-8) unstable; urgency=low + + [ Mehdi Dogguy ] + * Add ${ocaml:Provides} in debian/control + + [ Sylvain Le Gall ] + * Put ocaml.mk at the beginning of debian/rules + * Protect .cmi(s) by moving and restoring during build process + + -- Sylvain Le Gall Sat, 19 Dec 2009 23:08:33 +0000 + +ocamldap (2.1.8-7) unstable; urgency=low + + * Add myself to uploaders + * Change inclusion order in debian/rules to workaround a CDBS bug + * Move the package to section ocaml + * Remove old cmi files when cleaning (Closes: #549769) + * Upgrade Standards-Version to 3.8.3 + * Use new features of dh-ocaml (>= 0.9) + - Generate documentation using dh_ocamldoc + + -- Mehdi Dogguy Thu, 08 Oct 2009 23:18:01 +0200 + +ocamldap (2.1.8-6) unstable; urgency=low + + [ Stefano Zacchiroli ] + * fix vcs-svn field to point just above the debian/ dir + + [ Sylvain Le Gall ] + * Use ocaml 3.10.0-9 for generating .ocamldoc-apiref automatically + * Switch packaging to git + * Set maintainer to Debian OCaml Maintainers + * Add dh-ocaml build-dependency (rules/ocaml.mk) + * Upgrade debian/compat to 7 (use debian/clean) + * Upgrade Standards-Version to 3.8.0 (debian/README.source) + * Add Homepage field to debian/control + * Use OCAML_OCAMLDOC_* variables to generate documentatio + * Add ${misc:Depends} to dependencies + * Update debian/copyright file to use + http://wiki.debian.org/Proposals/CopyrightFormat + * Remove obsolete debian/control.in related variables and files + + -- Sylvain Le Gall Thu, 05 Mar 2009 01:12:21 +0100 + +ocamldap (2.1.8-5) unstable; urgency=low + + * Build for ocaml 3.10.0 + * Tighten build dependency for ocaml 3.10.0 + * Move standard documentation to standard OCaml documentation place + + -- Sylvain Le Gall Tue, 18 Sep 2007 11:10:01 +0200 + +ocamldap (2.1.8-4) experimental; urgency=low + + * Add missing dependency on ocaml-nox + + -- Sylvain Le Gall Tue, 24 Jul 2007 01:31:38 +0200 + +ocamldap (2.1.8-3) experimental; urgency=low + + * Upgrade debian/watch version to 3, + * Upgrade debhelper debian/compat to 5, + * Use CDBS for debian/rules, + * Suppress dependency on libldap2-dev and chrpath, since package + doesn't depend on it anymore, + * Change email address to gildor@debian.org everywhere + * Change watch URL to sf.net + * Rebuild for ocaml 3.10.0 + + -- Sylvain Le Gall Tue, 24 Jul 2007 01:18:22 +0200 + +ocamldap (2.1.8-2) unstable; urgency=low + + * Removed control.in as per new ocaml policy. + * Add XS-X-Vcs-Svn in control, + * Rebuilt to fix dependency on pcre.cma (Closes: #387319) + + -- Sylvain Le Gall Fri, 15 Sep 2006 00:10:29 +0200 + +ocamldap (2.1.8-1) unstable; urgency=low + + * New upstream release + + -- Sylvain Le Gall Tue, 11 Jul 2006 23:18:43 +0200 + +ocamldap (2.1.7-2) unstable; urgency=low + + * Change my email address to gildor@debian.org, + * Upgrade standards version to 3.7.2 (no change), + * Made debian/control a PHONY target, + + -- Sylvain Le Gall Tue, 13 Jun 2006 09:05:09 +0200 + +ocamldap (2.1.7-1) unstable; urgency=low + + * New upstream version + + -- Sylvain Le Gall Tue, 7 Feb 2006 00:51:08 +0100 + +ocamldap (2.1.6-2) unstable; urgency=low + + * Rebuild for OCaml 3.09.1 + + -- Sylvain Le Gall Wed, 11 Jan 2006 00:03:44 +0100 + +ocamldap (2.1.6-1) unstable; urgency=low + + * New upstream release + + -- Sylvain Le Gall Tue, 13 Dec 2005 01:07:22 +0100 + +ocamldap (2.1.5-2) unstable; urgency=low + + * Minor cosmetic changes to the rule files + * Remove hardcoded OCaml ABI + + -- Sylvain Le Gall Fri, 2 Dec 2005 22:46:26 +0100 + +ocamldap (2.1.5-1) unstable; urgency=low + + * New upstream release + * Update information of copyright: new upstream website, license is LGPL + * Set doc-base section to Apps/Programming + * Update authors of doc-base + * Remove libldap-ocaml.dirs, since it is now useless + * Remove /usr/lib/ocaml/3.08.3/ from libldap-ocaml-dev.dirs (use ocamlfind + insteed) + + -- Sylvain Le Gall Mon, 10 Oct 2005 21:46:15 +0200 + +ocamldap (2.1.4-1) unstable; urgency=low + + * New upstream release + * Transition to svn-buildpackage + + -- Sylvain Le Gall Sun, 14 Aug 2005 02:23:27 +0200 + +ocamldap (2.1.3-1) unstable; urgency=low + + * New upstream release + * Migration to Standards-Version 3.6.2.0 (no change) + * Adapt the watch file so that it can be used by Debian QA + * Add dependency on libocaml-ssl-dev + * Remove the package libldap-ocaml: the library is now 100% pure OCaml + * Use "ocamlfind ocamldoc -package ssl" to generate the documentation + * Adpat debian/rules: removes the "mv" of the shared library (no more shared + library) + + -- Sylvain Le Gall Fri, 22 Jul 2005 00:13:39 +0200 + +ocamldap (1.6.5-3) unstable; urgency=medium + + * Rebuild against ocamlnet 1.0 + + -- Sylvain Le Gall Mon, 18 Apr 2005 20:44:23 +0200 + +ocamldap (1.6.5-2) unstable; urgency=medium + + * Transition to ocaml 3.08.3 : depends on ocaml-nox-3.08.3 + + -- Sylvain Le Gall Wed, 30 Mar 2005 23:10:38 +0200 + +ocamldap (1.6.5-1) unstable; urgency=low + + * New upstream release + + -- Sylvain Le Gall Wed, 8 Dec 2004 01:14:35 +0100 + +ocamldap (1.6.1-2) unstable; urgency=low + + * Rebuilt against ocamlnet 0.98 + * debian/control + - changed Deps and Build-Deps accordingly + + -- Stefano Zacchiroli Thu, 9 Sep 2004 15:31:57 +0200 + +ocamldap (1.6.1-1) unstable; urgency=low + + * New upstream release + * Transition to ocaml 3.08. Files modified : + - control + - libldap-ocaml-dev.dirs + - rules + + -- Sylvain LE GALL Wed, 28 Jul 2004 00:21:47 +0200 + +ocamldap (1.4.6-1) unstable; urgency=low + + * New upstream release + + -- Sylvain LE GALL Mon, 10 May 2004 23:52:17 +0200 + +ocamldap (1.4.4-1) unstable; urgency=low + + * New upstream release + + -- Sylvain LE GALL Wed, 17 Mar 2004 00:22:13 +0100 + +ocamldap (1.4.3-1) unstable; urgency=low + + * New upstream release + + -- Sylvain LE GALL Mon, 23 Feb 2004 00:29:38 +0100 + +ocamldap (1.4.1-1) unstable; urgency=low + + * New upstream release + * Correction of the FTBFS with patch make_bytecode ( Closes: #231166 ). + + -- Sylvain LE GALL Sun, 1 Feb 2004 21:00:15 +0100 + +ocamldap (1.3.2-1) unstable; urgency=low + + * New upstream version + * makefile_findlib patch applied upstream don't use anymore + * ocamldoc patch applied upstream don't user anymore + * Move to ocaml-3.07 depends ( and install dir ) + + -- Sylvain LE GALL Mon, 19 Jan 2004 21:41:25 +0100 + +ocamldap (1.1.1-2) unstable; urgency=low + + * Added a watch file + + -- Sylvain LE GALL Thu, 8 Jan 2004 17:25:09 +0100 + +ocamldap (1.1.1-1) unstable; urgency=low + + * New upstream release + * Apply patches : + * makefile_findlib to install in the good temp directory + * Don't use debian/META anymore + * Don't use debian/patches/makefile, since now we use findlib to + install => add a dependency on ocaml-findlib + + -- Sylvain LE GALL Sun, 21 Sep 2003 17:08:59 +0200 + +ocamldap (1.1.0-1) unstable; urgency=low + + * First package + * The name of the package in the archive will be libldap-ocaml + following the ocaml policy convention + * As it will be uploaded to unstable : closes: #203249 + * Add a META file + * Apply patches : + * makefile to correct the makefile behavior when installing + * ocamldoc to generate a better doc for the module + + -- Sylvain LE GALL Thu, 4 Sep 2003 00:05:07 +0200 diff --git a/clean b/clean new file mode 100644 index 0000000..5f6c9e7 --- /dev/null +++ b/clean @@ -0,0 +1,3 @@ +varcc.cmo +varcc.cmi +varcc diff --git a/compat b/compat new file mode 100644 index 0000000..7f8f011 --- /dev/null +++ b/compat @@ -0,0 +1 @@ +7 diff --git a/control b/control new file mode 100644 index 0000000..d85d14b --- /dev/null +++ b/control @@ -0,0 +1,38 @@ +Source: ocamldap +Section: ocaml +Priority: optional +Maintainer: Debian OCaml Maintainers +Uploaders: + Mehdi Dogguy +Build-Depends: cdbs (>= 0.4.23-1.1~), + debhelper (>= 7), + ocaml-nox (>= 3.10.0-9~), + ocaml-findlib (>= 1.2.5), + libocamlnet-ocaml-dev (>= 2.2.9-7~), + libssl-ocaml-dev (>= 0.4.3-3~), + dh-ocaml (>= 0.9) +Standards-Version: 3.8.3 +Vcs-Git: git://anonscm.debian.org/pkg-ocaml-maint/packages/ocamldap.git +Vcs-Browser: http://anonscm.debian.org/gitweb/?p=pkg-ocaml-maint/packages/ocamldap.git +Homepage: http://sourceforge.net/projects/ocamldap/ + +Package: libldap-ocaml-dev +Architecture: any +Depends: + ${ocaml:Depends}, + ${shlibs:Depends}, + libocamlnet-ocaml-dev (>= 2.2.8.1-1), + libssl-ocaml-dev (>= 0.4.2-3), + ${misc:Depends} +Provides: + ${ocaml:Provides} +Description: LDAP bindings for OCaml + It supports the core ldap-client functions, including search, add, + modify, and delete. + . + It has now an object oriented interface which supports the above + features, and some additional ones. Such as, nice data structures + for local ldap entries which record local modifications and can sync + them with the server, fewer arguments needed to perform simple + tasks, and an API modeled after Perl's Net::LDAP. + diff --git a/copyright b/copyright new file mode 100644 index 0000000..9660fa2 --- /dev/null +++ b/copyright @@ -0,0 +1,30 @@ +Format-Specification: http://wiki.debian.org/Proposals/CopyrightFormat +Upstream-Author: Eric Stokes + Matthew Backe + Miles Egan (initial upstream) +Packaged-By: Sylvain Le Gall +Packaged-Date: Wed, 04 Sep 2003 00:05:39 +0200 +Original-Source-Location: http://sourceforge.net/projects/ocamldap/ + +Files: * +Copyright: (C) 2004 Eric Stokes + (C) 2004 Matthew Backes + (C) 2004 The California State University at Northridge +License: LGPL-2.1+ + + 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., 51 + Franklin St, Fifth Floor, Boston, MA 02110-1301, USA. + +Ocamldap is distributed under the terms of the LGPL licence, which can be +found in the /usr/share/common-licenses/LGPL file on debian systems. diff --git a/gbp.conf b/gbp.conf new file mode 100644 index 0000000..cec628c --- /dev/null +++ b/gbp.conf @@ -0,0 +1,2 @@ +[DEFAULT] +pristine-tar = True diff --git a/libldap-ocaml-dev.dirs.in b/libldap-ocaml-dev.dirs.in new file mode 100644 index 0000000..e6e0dd5 --- /dev/null +++ b/libldap-ocaml-dev.dirs.in @@ -0,0 +1,2 @@ +@OCamlStdlibDir@ +usr/share/doc/libldap-ocaml-dev/html/api/ diff --git a/libldap-ocaml-dev.examples b/libldap-ocaml-dev.examples new file mode 100644 index 0000000..071735e --- /dev/null +++ b/libldap-ocaml-dev.examples @@ -0,0 +1,3 @@ +test.ml +testoo.ml +testldif.ml diff --git a/libldap-ocaml-dev.ocamldoc b/libldap-ocaml-dev.ocamldoc new file mode 100644 index 0000000..c31341c --- /dev/null +++ b/libldap-ocaml-dev.ocamldoc @@ -0,0 +1 @@ + -package ssl diff --git a/patches/0001-Compile-explictly-with-pcre-and-compiler-libs.patch b/patches/0001-Compile-explictly-with-pcre-and-compiler-libs.patch new file mode 100644 index 0000000..75acd72 --- /dev/null +++ b/patches/0001-Compile-explictly-with-pcre-and-compiler-libs.patch @@ -0,0 +1,23 @@ +From: Stephane Glondu +Date: Sat, 7 Dec 2013 13:08:40 +0100 +Subject: Compile explictly with pcre and compiler-libs + +Bug-Debian: http://bugs.debian.org/cgi-bin/bugreport.cgi?bug=731405 +--- + Makefile | 2 +- + 1 file changed, 1 insertion(+), 1 deletion(-) + +diff --git a/Makefile b/Makefile +index 7d68f30..5226335 100644 +--- a/Makefile ++++ b/Makefile +@@ -12,7 +12,7 @@ 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 ++PACKS=netstring str ssl pcre compiler-libs + #OCAMLFLAGS=-rectypes + + LIBINSTALL_FILES=$(wildcard *.mli *.cmi *.cma *.cmxa *.a *.so *.o *.cmx ldap_toplevel.cmo) +-- diff --git a/patches/0002-Use-Ldap_funclient.init.patch b/patches/0002-Use-Ldap_funclient.init.patch new file mode 100644 index 0000000..c6c6012 --- /dev/null +++ b/patches/0002-Use-Ldap_funclient.init.patch @@ -0,0 +1,37 @@ +From: Mehdi Dogguy +Date: Sat, 17 Oct 2015 20:47:24 +0200 +Subject: Use Ldap_funclient.init + +--- + ldap_ooclient.ml | 6 +++--- + 1 file changed, 3 insertions(+), 3 deletions(-) + +diff --git a/ldap_ooclient.ml b/ldap_ooclient.ml +index fd8b487..19b8df3 100644 +--- a/ldap_ooclient.ml ++++ b/ldap_ooclient.ml +@@ -410,12 +410,12 @@ object (self) + val mutable mth = `SIMPLE + val mutable bound = true + val mutable reconnect_successful = true +- val mutable con = init ~connect_timeout:connect_timeout ~version:version hosts ++ val mutable con = Ldap_funclient.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; ++ con <- Ldap_funclient.init ~connect_timeout:connect_timeout ~version:version hosts; + bound <- true; + bind_s ~who: bdn ~cred: pwd ~auth_method: mth con; + reconnect_successful <- true; +@@ -429,7 +429,7 @@ object (self) + + method bind ?(cred = "") ?(meth:authmethod = `SIMPLE) dn = + if not bound then begin +- con <- init ~connect_timeout:connect_timeout ~version: version hosts; ++ con <- Ldap_funclient.init ~connect_timeout:connect_timeout ~version: version hosts; + bound <- true + end; + bind_s ~who: dn ~cred: cred ~auth_method: meth con; +-- diff --git a/patches/series b/patches/series new file mode 100644 index 0000000..c8bacc3 --- /dev/null +++ b/patches/series @@ -0,0 +1,2 @@ +0001-Compile-explictly-with-pcre-and-compiler-libs.patch +0002-Use-Ldap_funclient.init.patch diff --git a/rules b/rules new file mode 100755 index 0000000..d828361 --- /dev/null +++ b/rules @@ -0,0 +1,48 @@ +#!/usr/bin/make -f +# debian/rules for ocamldap package +# Copyright (C) 2006 Sylvain Le Gall +# +# This program is free software; you can redistribute it and/or +# modify it under the terms of the GNU General Public License as +# published by the Free Software Foundation; either version 2, or (at +# your option) any later version. +# +# This program 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 +# General Public License for more details. +# +# You should have received a copy of the GNU General Public License +# along with this program; if not, write to the Free Software +# Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, +# MA 02110-1301, USA. + + +include /usr/share/cdbs/1/rules/ocaml.mk +include /usr/share/cdbs/1/rules/debhelper.mk +include /usr/share/cdbs/1/class/makefile.mk + +PACKAGE_DEV := libldap-ocaml-dev +DESTDIR_DEV := $(CURDIR)/debian/$(PACKAGE_DEV) + +DEB_MAKE_CLEAN_TARGET := clean + +DEB_MAKE_BUILD_TARGET := all +ifeq ($(OCAML_HAVE_OCAMLOPT),yes) +DEB_MAKE_BUILD_TARGET += opt +endif + +DEB_MAKE_INSTALL_TARGET := install \ + OCAMLFIND_INSTFLAGS="-ldconf ignore -destdir $(DESTDIR_DEV)/$(OCAML_STDLIB_DIR)" + +debian/protect-stamp: + -mv ldap_urlparser.cmi ldap_urlparser.cmi.old + -mv testoo.cmi testoo.cmi.old + touch $@ + +pre-build:: debian/protect-stamp + +clean:: debian/protect-stamp + -mv ldap_urlparser.cmi.old ldap_urlparser.cmi + -mv testoo.cmi.old testoo.cmi + -$(RM) debian/protect-stamp diff --git a/source/format b/source/format new file mode 100644 index 0000000..163aaf8 --- /dev/null +++ b/source/format @@ -0,0 +1 @@ +3.0 (quilt) diff --git a/watch b/watch new file mode 100644 index 0000000..bc5e523 --- /dev/null +++ b/watch @@ -0,0 +1,2 @@ +version=3 +http://sf.net/ocamldap/ocamldap-([0-9\.]*).tar.bz2 -- cgit v1.2.3 From 0ae36395228de15273f061049d9b582a524a4540 Mon Sep 17 00:00:00 2001 From: Stephane Glondu Date: Sat, 7 Dec 2013 13:08:40 +0100 Subject: Compile explictly with pcre and compiler-libs Bug-Debian: http://bugs.debian.org/cgi-bin/bugreport.cgi?bug=731405 Gbp-Pq: Name 0001-Compile-explictly-with-pcre-and-compiler-libs.patch --- Makefile | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/Makefile b/Makefile index 7d68f30..5226335 100644 --- a/Makefile +++ b/Makefile @@ -12,7 +12,7 @@ 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 +PACKS=netstring str ssl pcre compiler-libs #OCAMLFLAGS=-rectypes LIBINSTALL_FILES=$(wildcard *.mli *.cmi *.cma *.cmxa *.a *.so *.o *.cmx ldap_toplevel.cmo) -- cgit v1.2.3 From 8734b01372144c91a113ddf854fe593a9a24232b Mon Sep 17 00:00:00 2001 From: Mehdi Dogguy Date: Sat, 17 Oct 2015 20:47:24 +0200 Subject: Use Ldap_funclient.init Gbp-Pq: Name 0002-Use-Ldap_funclient.init.patch --- ldap_ooclient.ml | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/ldap_ooclient.ml b/ldap_ooclient.ml index fd8b487..19b8df3 100644 --- a/ldap_ooclient.ml +++ b/ldap_ooclient.ml @@ -410,12 +410,12 @@ object (self) val mutable mth = `SIMPLE val mutable bound = true val mutable reconnect_successful = true - val mutable con = init ~connect_timeout:connect_timeout ~version:version hosts + val mutable con = Ldap_funclient.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; + con <- Ldap_funclient.init ~connect_timeout:connect_timeout ~version:version hosts; bound <- true; bind_s ~who: bdn ~cred: pwd ~auth_method: mth con; reconnect_successful <- true; @@ -429,7 +429,7 @@ object (self) method bind ?(cred = "") ?(meth:authmethod = `SIMPLE) dn = if not bound then begin - con <- init ~connect_timeout:connect_timeout ~version: version hosts; + con <- Ldap_funclient.init ~connect_timeout:connect_timeout ~version: version hosts; bound <- true end; bind_s ~who: dn ~cred: cred ~auth_method: meth con; -- cgit v1.2.3 From d6036bb934aa86a1dc7d0085c2a45c29e5f11542 Mon Sep 17 00:00:00 2001 From: Stephane Glondu Date: Sat, 7 Dec 2013 13:08:40 +0100 Subject: Compile explictly with pcre and compiler-libs Bug-Debian: http://bugs.debian.org/cgi-bin/bugreport.cgi?bug=731405 Gbp-Pq: Name 0001-Compile-explictly-with-pcre-and-compiler-libs.patch --- Makefile | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/Makefile b/Makefile index 7d68f30..5226335 100644 --- a/Makefile +++ b/Makefile @@ -12,7 +12,7 @@ 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 +PACKS=netstring str ssl pcre compiler-libs #OCAMLFLAGS=-rectypes LIBINSTALL_FILES=$(wildcard *.mli *.cmi *.cma *.cmxa *.a *.so *.o *.cmx ldap_toplevel.cmo) -- cgit v1.2.3 From b517e527fa6dbe4c5a20cb24fdf8ecb0b0b13766 Mon Sep 17 00:00:00 2001 From: Mehdi Dogguy Date: Sat, 17 Oct 2015 20:47:24 +0200 Subject: Use Ldap_funclient.init Gbp-Pq: Name 0002-Use-Ldap_funclient.init.patch --- ldap_ooclient.ml | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/ldap_ooclient.ml b/ldap_ooclient.ml index fd8b487..19b8df3 100644 --- a/ldap_ooclient.ml +++ b/ldap_ooclient.ml @@ -410,12 +410,12 @@ object (self) val mutable mth = `SIMPLE val mutable bound = true val mutable reconnect_successful = true - val mutable con = init ~connect_timeout:connect_timeout ~version:version hosts + val mutable con = Ldap_funclient.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; + con <- Ldap_funclient.init ~connect_timeout:connect_timeout ~version:version hosts; bound <- true; bind_s ~who: bdn ~cred: pwd ~auth_method: mth con; reconnect_successful <- true; @@ -429,7 +429,7 @@ object (self) method bind ?(cred = "") ?(meth:authmethod = `SIMPLE) dn = if not bound then begin - con <- init ~connect_timeout:connect_timeout ~version: version hosts; + con <- Ldap_funclient.init ~connect_timeout:connect_timeout ~version: version hosts; bound <- true end; bind_s ~who: dn ~cred: cred ~auth_method: meth con; -- cgit v1.2.3 From a5f19f575a9ee463e3828c782d3b75a20c054728 Mon Sep 17 00:00:00 2001 From: Stephane Glondu Date: Fri, 6 Sep 2019 09:26:49 +0200 Subject: Fix compilation with OCaml 4.08.0 Gbp-Pq: Name 0003-Fix-compilation-with-OCaml-4.08.0.patch --- lber.ml | 22 +++++++++++----------- ldap_dn.ml | 2 +- ldap_funclient.ml | 2 +- ldap_funserver.ml | 2 +- 4 files changed, 14 insertions(+), 14 deletions(-) diff --git a/lber.ml b/lber.ml index 37d3ce0..d2f170f 100644 --- a/lber.ml +++ b/lber.ml @@ -194,11 +194,11 @@ let readbyte_of_readfun rfun = String.blit iresult 0 result !total nbytes_to_read; total := !total + nbytes_to_read done; - result + Bytes.to_string result ) else if not peek then ( if length <= !buf_len - !buf_pos then ( - let result = String.sub buf !buf_pos length in + let result = Bytes.sub_string buf !buf_pos length in buf_pos := !buf_pos + length; peek_pos := !buf_pos; result @@ -212,29 +212,29 @@ let readbyte_of_readfun rfun = 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; + Bytes.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; + Bytes.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 + Bytes.to_string result ) else ( - String.blit buf 0 buf (!buf_pos + length) (nbytes_really_in_buffer - length); + Bytes.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 + Bytes.to_string result ) ) ) (* if not peek *) else ( if length <= (!buf_len + !peek_buf_len) - !peek_pos then ( - let result = String.sub buf !peek_pos length in + let result = Bytes.sub_string buf !peek_pos length in peek_pos := !peek_pos + length; result ) @@ -244,17 +244,17 @@ let readbyte_of_readfun rfun = 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; + Bytes.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; + Bytes.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 + Bytes.to_string result ) ) in diff --git a/ldap_dn.ml b/ldap_dn.ml index 346e6e5..62d426a 100644 --- a/ldap_dn.ml +++ b/ldap_dn.ml @@ -58,7 +58,7 @@ let hexpair_of_char c = let buf = String.create 2 in buf.[0] <- hexify ((lsr) i 4); buf.[1] <- hexify ((land) i 0b0000_1111); - buf + Bytes.to_string buf let escape_value valu = let strm = Stream.of_string valu in diff --git a/ldap_funclient.ml b/ldap_funclient.ml index a6d2925..e2c4632 100644 --- a/ldap_funclient.ml +++ b/ldap_funclient.ml @@ -86,7 +86,7 @@ let send_message con msg = try while !written < len do - written := ((write con.socket e_msg + written := ((write con.socket (Bytes.of_string e_msg) !written (len - !written)) + !written) done diff --git a/ldap_funserver.ml b/ldap_funserver.ml index e79cbf8..a24bf82 100644 --- a/ldap_funserver.ml +++ b/ldap_funserver.ml @@ -99,7 +99,7 @@ let send_message si conn_id op_nr fd msg = try while !written < len do - written := ((write fd e_msg + written := ((write fd (Bytes.of_string e_msg) !written (len - !written)) + !written) done; -- cgit v1.2.3 From b47cea7d3a3854a299e049092df22735f5c83506 Mon Sep 17 00:00:00 2001 From: Stephane Glondu Date: Sun, 29 Aug 2021 13:04:52 +0200 Subject: Do not run tests that use network Forwarded: not-needed Gbp-Pq: Name 0001-Do-not-run-tests-that-use-network.patch --- tests/ldap/dune | 1 - 1 file changed, 1 deletion(-) diff --git a/tests/ldap/dune b/tests/ldap/dune index e77dfc1..220e053 100644 --- a/tests/ldap/dune +++ b/tests/ldap/dune @@ -7,5 +7,4 @@ (deps test.exe) (action (progn - (run %{exe:page_result_control_test.exe}) (run %{exe:lber_tests.exe})))) -- cgit v1.2.3