diff options
Diffstat (limited to 'lib')
| -rw-r--r-- | lib/eldap/.gitignore | 4 | ||||
| -rw-r--r-- | lib/eldap/LICENSE | 21 | ||||
| -rw-r--r-- | lib/eldap/README | 33 | ||||
| -rw-r--r-- | lib/eldap/asn1/ELDAPv3.asn1 | 278 | ||||
| -rw-r--r-- | lib/eldap/ebin/.gitignore | 0 | ||||
| -rw-r--r-- | lib/eldap/include/eldap.hrl | 32 | ||||
| -rw-r--r-- | lib/eldap/src/eldap.app.src | 9 | ||||
| -rw-r--r-- | lib/eldap/src/eldap.erl | 1078 | ||||
| -rw-r--r-- | lib/eldap/src/eldap_app.erl | 16 | ||||
| -rw-r--r-- | lib/eldap/src/eldap_fsm.erl | 946 | ||||
| -rw-r--r-- | lib/eldap/src/eldap_sup.erl | 28 |
11 files changed, 2445 insertions, 0 deletions
diff --git a/lib/eldap/.gitignore b/lib/eldap/.gitignore new file mode 100644 index 0000000000..5585418186 --- /dev/null +++ b/lib/eldap/.gitignore @@ -0,0 +1,4 @@ +*.beam +*.asn1db +src/ELDAPv3.hrl +src/ELDAPv3.erl diff --git a/lib/eldap/LICENSE b/lib/eldap/LICENSE new file mode 100644 index 0000000000..1f6200918f --- /dev/null +++ b/lib/eldap/LICENSE @@ -0,0 +1,21 @@ + +Copyright (c) 2010, Torbjorn Tornkvist + +Permission is hereby granted, free of charge, to any person obtaining a copy +of this software and associated documentation files (the "Software"), to deal +in the Software without restriction, including without limitation the rights +to use, copy, modify, merge, publish, distribute, sublicense, and/or sell +copies of the Software, and to permit persons to whom the Software is +furnished to do so, subject to the following conditions: + +The above copyright notice and this permission notice shall be included in +all copies or substantial portions of the Software. + +THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR +IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, +FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE +AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER +LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, +OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN +THE SOFTWARE. + diff --git a/lib/eldap/README b/lib/eldap/README new file mode 100644 index 0000000000..e1bde9d658 --- /dev/null +++ b/lib/eldap/README @@ -0,0 +1,33 @@ +Hi, + +This is 'eldap', the Erlang LDAP library. + +It exports an API that can do all possible operations +you may want to do against an LDAP server. The code has +been tested to work at some point, but only the bind +and search operations are running daily in our products, +so there may be bugs lurking in some parts of the code. + +To just use eldap for doing authentication, do like in: + + {ok,X} = eldap:open(["ldap.mycorp.com"], []). + eldap:simple_bind(X, "uid=tobbe,ou=People,dc=mycorp,dc=com", "passwd"). + +In the doc/README.example you'll find a trace from a +Erlang shell session as an example on how to setup a +connection, authenticate (bind) and perform a search. +Note that by using the option {ssl, true}, you should +be able to setup an SSL tunnel (LDAPS) if your Erlang +system has been configured with SSL. + +In the test directory there are some hints and examples +on how to test the code and how to setup and populate +an OpenLDAP server. The 'eldap' code has been tested +agains OpenLDAP, IPlanet and ActiveDirectory servers. + +If you plan to incorporate this code into your system +I suggest that you build a server/supervisor harnesk +that uses 'eldap' (as we have done in our products). + +Good luck ! +/Tobbe diff --git a/lib/eldap/asn1/ELDAPv3.asn1 b/lib/eldap/asn1/ELDAPv3.asn1 new file mode 100644 index 0000000000..72b87d7221 --- /dev/null +++ b/lib/eldap/asn1/ELDAPv3.asn1 @@ -0,0 +1,278 @@ +-- Lightweight-Directory-Access-Protocol-V3 {1 3 6 1 1 18} +-- Copyright (C) The Internet Society (2006). This version of +-- this ASN.1 module is part of RFC 4511; see the RFC itself +-- for full legal notices. +ELDAPv3 DEFINITIONS +IMPLICIT TAGS +EXTENSIBILITY IMPLIED ::= + +BEGIN + +LDAPMessage ::= SEQUENCE { + messageID MessageID, + protocolOp CHOICE { + bindRequest BindRequest, + bindResponse BindResponse, + unbindRequest UnbindRequest, + searchRequest SearchRequest, + searchResEntry SearchResultEntry, + searchResDone SearchResultDone, + searchResRef SearchResultReference, + modifyRequest ModifyRequest, + modifyResponse ModifyResponse, + addRequest AddRequest, + addResponse AddResponse, + delRequest DelRequest, + delResponse DelResponse, + modDNRequest ModifyDNRequest, + modDNResponse ModifyDNResponse, + compareRequest CompareRequest, + compareResponse CompareResponse, + abandonRequest AbandonRequest, + extendedReq ExtendedRequest, + extendedResp ExtendedResponse, + ..., + intermediateResponse IntermediateResponse }, + controls [0] Controls OPTIONAL } + +MessageID ::= INTEGER (0 .. maxInt) + +maxInt INTEGER ::= 2147483647 -- (2^^31 - 1) -- + +LDAPString ::= OCTET STRING -- UTF-8 encoded, + -- [ISO10646] characters + +LDAPOID ::= OCTET STRING -- Constrained to <numericoid> + -- [RFC4512] + +LDAPDN ::= LDAPString -- Constrained to <distinguishedName> + -- [RFC4514] + +RelativeLDAPDN ::= LDAPString -- Constrained to <name-component> + -- [RFC4514] + +AttributeDescription ::= LDAPString + -- Constrained to <attributedescription> + -- [RFC4512] + +AttributeValue ::= OCTET STRING + +AttributeValueAssertion ::= SEQUENCE { + attributeDesc AttributeDescription, + assertionValue AssertionValue } + +AssertionValue ::= OCTET STRING + +PartialAttribute ::= SEQUENCE { + type AttributeDescription, + vals SET OF value AttributeValue } + +Attribute ::= PartialAttribute(WITH COMPONENTS { + ..., + vals (SIZE(1..MAX))}) + +MatchingRuleId ::= LDAPString + +LDAPResult ::= SEQUENCE { + resultCode ENUMERATED { + success (0), + operationsError (1), + protocolError (2), + timeLimitExceeded (3), + sizeLimitExceeded (4), + compareFalse (5), + compareTrue (6), + authMethodNotSupported (7), + strongerAuthRequired (8), + -- 9 reserved -- + referral (10), + adminLimitExceeded (11), + unavailableCriticalExtension (12), + confidentialityRequired (13), + saslBindInProgress (14), + + noSuchAttribute (16), + undefinedAttributeType (17), + inappropriateMatching (18), + constraintViolation (19), + attributeOrValueExists (20), + invalidAttributeSyntax (21), + -- 22-31 unused -- + noSuchObject (32), + aliasProblem (33), + invalidDNSyntax (34), + -- 35 reserved for undefined isLeaf -- + aliasDereferencingProblem (36), + -- 37-47 unused -- + inappropriateAuthentication (48), + invalidCredentials (49), + insufficientAccessRights (50), + busy (51), + unavailable (52), + unwillingToPerform (53), + loopDetect (54), + -- 55-63 unused -- + namingViolation (64), + objectClassViolation (65), + notAllowedOnNonLeaf (66), + notAllowedOnRDN (67), + entryAlreadyExists (68), + objectClassModsProhibited (69), + -- 70 reserved for CLDAP -- + affectsMultipleDSAs (71), + -- 72-79 unused -- + other (80), + ... }, + matchedDN LDAPDN, + diagnosticMessage LDAPString, + referral [3] Referral OPTIONAL } + +Referral ::= SEQUENCE SIZE (1..MAX) OF uri URI + +URI ::= LDAPString -- limited to characters permitted in + -- URIs + +Controls ::= SEQUENCE OF control Control + +Control ::= SEQUENCE { + controlType LDAPOID, + criticality BOOLEAN DEFAULT FALSE, + controlValue OCTET STRING OPTIONAL } + +BindRequest ::= [APPLICATION 0] SEQUENCE { + version INTEGER (1 .. 127), + name LDAPDN, + authentication AuthenticationChoice } + +AuthenticationChoice ::= CHOICE { + simple [0] OCTET STRING, + -- 1 and 2 reserved + sasl [3] SaslCredentials, + ... } + +SaslCredentials ::= SEQUENCE { + mechanism LDAPString, + credentials OCTET STRING OPTIONAL } + +BindResponse ::= [APPLICATION 1] SEQUENCE { + COMPONENTS OF LDAPResult, + serverSaslCreds [7] OCTET STRING OPTIONAL } + +UnbindRequest ::= [APPLICATION 2] NULL + +SearchRequest ::= [APPLICATION 3] SEQUENCE { + baseObject LDAPDN, + scope ENUMERATED { + baseObject (0), + singleLevel (1), + wholeSubtree (2), + ... }, + derefAliases ENUMERATED { + neverDerefAliases (0), + derefInSearching (1), + derefFindingBaseObj (2), + derefAlways (3) }, + sizeLimit INTEGER (0 .. maxInt), + timeLimit INTEGER (0 .. maxInt), + typesOnly BOOLEAN, + filter Filter, + attributes AttributeSelection } + +AttributeSelection ::= SEQUENCE OF selector LDAPString + -- The LDAPString is constrained to + -- <attributeSelector> in Section 4.5.1.8 + +Filter ::= CHOICE { + and [0] SET SIZE (1..MAX) OF filter Filter, + or [1] SET SIZE (1..MAX) OF filter Filter, + not [2] Filter, + equalityMatch [3] AttributeValueAssertion, + substrings [4] SubstringFilter, + greaterOrEqual [5] AttributeValueAssertion, + lessOrEqual [6] AttributeValueAssertion, + present [7] AttributeDescription, + approxMatch [8] AttributeValueAssertion, + extensibleMatch [9] MatchingRuleAssertion, + ... } + +SubstringFilter ::= SEQUENCE { + type AttributeDescription, + substrings SEQUENCE SIZE (1..MAX) OF substring CHOICE { + initial [0] AssertionValue, -- can occur at most once + any [1] AssertionValue, + final [2] AssertionValue } -- can occur at most once + } + +MatchingRuleAssertion ::= SEQUENCE { + matchingRule [1] MatchingRuleId OPTIONAL, + type [2] AttributeDescription OPTIONAL, + matchValue [3] AssertionValue, + dnAttributes [4] BOOLEAN DEFAULT FALSE } + +SearchResultEntry ::= [APPLICATION 4] SEQUENCE { + objectName LDAPDN, + attributes PartialAttributeList } + +PartialAttributeList ::= SEQUENCE OF + partialAttribute PartialAttribute + +SearchResultReference ::= [APPLICATION 19] SEQUENCE + SIZE (1..MAX) OF uri URI + +SearchResultDone ::= [APPLICATION 5] LDAPResult + +ModifyRequest ::= [APPLICATION 6] SEQUENCE { + object LDAPDN, + changes SEQUENCE OF change SEQUENCE { + operation ENUMERATED { + add (0), + delete (1), + replace (2), + ... }, + modification PartialAttribute } } + +ModifyResponse ::= [APPLICATION 7] LDAPResult + +AddRequest ::= [APPLICATION 8] SEQUENCE { + entry LDAPDN, + attributes AttributeList } + +AttributeList ::= SEQUENCE OF attribute Attribute + +AddResponse ::= [APPLICATION 9] LDAPResult + +DelRequest ::= [APPLICATION 10] LDAPDN + +DelResponse ::= [APPLICATION 11] LDAPResult + +ModifyDNRequest ::= [APPLICATION 12] SEQUENCE { + entry LDAPDN, + newrdn RelativeLDAPDN, + deleteoldrdn BOOLEAN, + newSuperior [0] LDAPDN OPTIONAL } + +ModifyDNResponse ::= [APPLICATION 13] LDAPResult + +CompareRequest ::= [APPLICATION 14] SEQUENCE { + entry LDAPDN, + ava AttributeValueAssertion } + +CompareResponse ::= [APPLICATION 15] LDAPResult + +AbandonRequest ::= [APPLICATION 16] MessageID + +ExtendedRequest ::= [APPLICATION 23] SEQUENCE { + requestName [0] LDAPOID, + requestValue [1] OCTET STRING OPTIONAL } + +ExtendedResponse ::= [APPLICATION 24] SEQUENCE { + COMPONENTS OF LDAPResult, + responseName [10] LDAPOID OPTIONAL, + responseValue [11] OCTET STRING OPTIONAL } + +IntermediateResponse ::= [APPLICATION 25] SEQUENCE { + responseName [0] LDAPOID OPTIONAL, + responseValue [1] OCTET STRING OPTIONAL } + +END + diff --git a/lib/eldap/ebin/.gitignore b/lib/eldap/ebin/.gitignore new file mode 100644 index 0000000000..e69de29bb2 --- /dev/null +++ b/lib/eldap/ebin/.gitignore diff --git a/lib/eldap/include/eldap.hrl b/lib/eldap/include/eldap.hrl new file mode 100644 index 0000000000..ee5ad2f0d3 --- /dev/null +++ b/lib/eldap/include/eldap.hrl @@ -0,0 +1,32 @@ +-ifndef( _ELDAP_HRL ). +-define( _ELDAP_HRL , 1 ). + +%%% +%%% Search input parameters +%%% +-record(eldap_search, { + base = [], % Baseobject + filter = [], % Search conditions + scope, % Search scope + attributes = [], % Attributes to be returned + types_only = false, % Return types+values or types + timeout = 0 % Timelimit for search + }). + +%%% +%%% Returned search result +%%% +-record(eldap_search_result, { + entries = [], % List of #eldap_entry{} records + referrals = [] % List of referrals + }). + +%%% +%%% LDAP entry +%%% +-record(eldap_entry, { + object_name = "", % The DN for the entry + attributes = [] % List of {Attribute, Value} pairs + }). + +-endif. diff --git a/lib/eldap/src/eldap.app.src b/lib/eldap/src/eldap.app.src new file mode 100644 index 0000000000..ae43c6da4b --- /dev/null +++ b/lib/eldap/src/eldap.app.src @@ -0,0 +1,9 @@ +{application, eldap, + [{description, "Ldap api"}, + {vsn, "%VSN%"}, + {modules, []}, + {registered, []}, + {applications, [kernel, stdlib]}, + {mod, { eldap_app, []}}, + {env, []} +]}. diff --git a/lib/eldap/src/eldap.erl b/lib/eldap/src/eldap.erl new file mode 100644 index 0000000000..7c9c02d681 --- /dev/null +++ b/lib/eldap/src/eldap.erl @@ -0,0 +1,1078 @@ +-module(eldap). +%%% -------------------------------------------------------------------- +%%% Created: 12 Oct 2000 by Tobbe <[email protected]> +%%% Function: Erlang client LDAP implementation according RFC 2251,2253 +%%% and 2255. The interface is based on RFC 1823, and +%%% draft-ietf-asid-ldap-c-api-00.txt +%%% +%%% Copyright (c) 2010 Torbjorn Tornkvist +%%% See MIT-LICENSE at the top dir for licensing information. +%%% -------------------------------------------------------------------- +-vc('$Id$ '). +-export([open/1,open/2,simple_bind/3,controlling_process/2, + baseObject/0,singleLevel/0,wholeSubtree/0,close/1, + equalityMatch/2,greaterOrEqual/2,lessOrEqual/2, + approxMatch/2,search/2,substrings/2,present/1, + 'and'/1,'or'/1,'not'/1,modify/3, mod_add/2, mod_delete/2, + mod_replace/2, add/3, delete/2, modify_dn/5,parse_dn/1, + parse_ldap_url/1]). + +-import(lists,[concat/1]). + +-include("ELDAPv3.hrl"). +-include("eldap.hrl"). + +-define(LDAP_VERSION, 3). +-define(LDAP_PORT, 389). +-define(LDAPS_PORT, 636). + +-record(eldap, {version = ?LDAP_VERSION, + host, % Host running LDAP server + port = ?LDAP_PORT, % The LDAP server port + fd, % Socket filedescriptor. + binddn = "", % Name of the entry to bind as + passwd, % Password for (above) entry + id = 0, % LDAP Request ID + log, % User provided log function + timeout = infinity, % Request timeout + anon_auth = false, % Allow anonymous authentication + use_tls = false % LDAP/LDAPS + }). + +%%% For debug purposes +%%-define(PRINT(S, A), io:fwrite("~w(~w): " ++ S, [?MODULE,?LINE|A])). +-define(PRINT(S, A), true). + +-define(elog(S, A), error_logger:info_msg("~w(~w): "++S,[?MODULE,?LINE|A])). + +%%% ==================================================================== +%%% Exported interface +%%% ==================================================================== + +%%% -------------------------------------------------------------------- +%%% open(Hosts [,Opts] ) +%%% -------------------- +%%% Setup a connection to on of the Hosts in the argument +%%% list. Stop at the first successful connection attempt. +%%% Valid Opts are: Where: +%%% +%%% {port, Port} - Port is the port number +%%% {log, F} - F(LogLevel, FormatString, ListOfArgs) +%%% {timeout, milliSec} - request timeout +%%% +%%% -------------------------------------------------------------------- +open(Hosts) -> + open(Hosts, []). + +open(Hosts, Opts) when is_list(Hosts), is_list(Opts) -> + Self = self(), + Pid = spawn_link(fun() -> init(Hosts, Opts, Self) end), + recv(Pid). + +%%% -------------------------------------------------------------------- +%%% Shutdown connection (and process) asynchronous. +%%% -------------------------------------------------------------------- + +close(Handle) when is_pid(Handle) -> + send(Handle, close). + +%%% -------------------------------------------------------------------- +%%% Set who we should link ourselves to +%%% -------------------------------------------------------------------- + +controlling_process(Handle, Pid) when is_pid(Handle), is_pid(Pid) -> + link(Pid), + send(Handle, {cnt_proc, Pid}), + recv(Handle). + +%%% -------------------------------------------------------------------- +%%% Authenticate ourselves to the Directory +%%% using simple authentication. +%%% +%%% Dn - The name of the entry to bind as +%%% Passwd - The password to be used +%%% +%%% Returns: ok | {error, Error} +%%% -------------------------------------------------------------------- +simple_bind(Handle, Dn, Passwd) when is_pid(Handle) -> + send(Handle, {simple_bind, Dn, Passwd}), + recv(Handle). + +%%% -------------------------------------------------------------------- +%%% Add an entry. The entry field MUST NOT exist for the AddRequest +%%% to succeed. The parent of the entry MUST exist. +%%% Example: +%%% +%%% add(Handle, +%%% "cn=Bill Valentine, ou=people, o=Bluetail AB, dc=bluetail, dc=com", +%%% [{"objectclass", ["person"]}, +%%% {"cn", ["Bill Valentine"]}, +%%% {"sn", ["Valentine"]}, +%%% {"telephoneNumber", ["545 555 00"]}] +%%% ) +%%% -------------------------------------------------------------------- +add(Handle, Entry, Attributes) when is_pid(Handle),is_list(Entry),is_list(Attributes) -> + send(Handle, {add, Entry, add_attrs(Attributes)}), + recv(Handle). + +%%% Do sanity check ! +add_attrs(Attrs) -> + F = fun({Type,Vals}) when is_list(Type),is_list(Vals) -> + %% Confused ? Me too... :-/ + {'AddRequest_attributes',Type, Vals} + end, + case catch lists:map(F, Attrs) of + {'EXIT', _} -> throw({error, attribute_values}); + Else -> Else + end. + +%%% -------------------------------------------------------------------- +%%% Delete an entry. The entry consists of the DN of +%%% the entry to be deleted. +%%% Example: +%%% +%%% delete(Handle, +%%% "cn=Bill Valentine, ou=people, o=Bluetail AB, dc=bluetail, dc=com" +%%% ) +%%% -------------------------------------------------------------------- +delete(Handle, Entry) when is_pid(Handle), is_list(Entry) -> + send(Handle, {delete, Entry}), + recv(Handle). + +%%% -------------------------------------------------------------------- +%%% Modify an entry. Given an entry a number of modification +%%% operations can be performed as one atomic operation. +%%% Example: +%%% +%%% modify(Handle, +%%% "cn=Torbjorn Tornkvist, ou=people, o=Bluetail AB, dc=bluetail, dc=com", +%%% [replace("telephoneNumber", ["555 555 00"]), +%%% add("description", ["LDAP hacker"])] +%%% ) +%%% -------------------------------------------------------------------- +modify(Handle, Object, Mods) when is_pid(Handle), is_list(Object), is_list(Mods) -> + send(Handle, {modify, Object, Mods}), + recv(Handle). + +%%% +%%% Modification operations. +%%% Example: +%%% replace("telephoneNumber", ["555 555 00"]) +%%% +mod_add(Type, Values) when is_list(Type), is_list(Values) -> m(add, Type, Values). +mod_delete(Type, Values) when is_list(Type), is_list(Values) -> m(delete, Type, Values). +mod_replace(Type, Values) when is_list(Type), is_list(Values) -> m(replace, Type, Values). + +m(Operation, Type, Values) -> + #'ModifyRequest_changes_SEQOF'{ + operation = Operation, + modification = #'PartialAttribute'{ + type = Type, + vals = Values}}. + +%%% -------------------------------------------------------------------- +%%% Modify an entry. Given an entry a number of modification +%%% operations can be performed as one atomic operation. +%%% Example: +%%% +%%% modify_dn(Handle, +%%% "cn=Bill Valentine, ou=people, o=Bluetail AB, dc=bluetail, dc=com", +%%% "cn=Ben Emerson", +%%% true, +%%% "" +%%% ) +%%% -------------------------------------------------------------------- +modify_dn(Handle, Entry, NewRDN, DelOldRDN, NewSup) + when is_pid(Handle),is_list(Entry),is_list(NewRDN),is_atom(DelOldRDN),is_list(NewSup) -> + send(Handle, {modify_dn, Entry, NewRDN, + bool_p(DelOldRDN), optional(NewSup)}), + recv(Handle). + +%%% Sanity checks ! + +bool_p(Bool) when Bool==true;Bool==false -> Bool. + +optional([]) -> asn1_NOVALUE; +optional(Value) -> Value. + +%%% -------------------------------------------------------------------- +%%% Synchronous search of the Directory returning a +%%% requested set of attributes. +%%% +%%% Example: +%%% +%%% Filter = eldap:substrings("sn", [{any,"o"}]), +%%% eldap:search(S, [{base, "dc=bluetail, dc=com"}, +%%% {filter, Filter}, +%%% {attributes,["cn"]}])), +%%% +%%% Returned result: {ok, #eldap_search_result{}} +%%% +%%% Example: +%%% +%%% {ok,{eldap_search_result, +%%% [{eldap_entry, +%%% "cn=Magnus Froberg, dc=bluetail, dc=com", +%%% [{"cn",["Magnus Froberg"]}]}, +%%% {eldap_entry, +%%% "cn=Torbjorn Tornkvist, dc=bluetail, dc=com", +%%% [{"cn",["Torbjorn Tornkvist"]}]}], +%%% []}} +%%% +%%% -------------------------------------------------------------------- +search(Handle, A) when is_pid(Handle), is_record(A, eldap_search) -> + call_search(Handle, A); +search(Handle, L) when is_pid(Handle), is_list(L) -> + case catch parse_search_args(L) of + {error, Emsg} -> {error, Emsg}; + A when is_record(A, eldap_search) -> call_search(Handle, A) + end. + +call_search(Handle, A) -> + send(Handle, {search, A}), + recv(Handle). + +parse_search_args(Args) -> + parse_search_args(Args, #eldap_search{scope = wholeSubtree}). + +parse_search_args([{base, Base}|T],A) -> + parse_search_args(T,A#eldap_search{base = Base}); +parse_search_args([{filter, Filter}|T],A) -> + parse_search_args(T,A#eldap_search{filter = Filter}); +parse_search_args([{scope, Scope}|T],A) -> + parse_search_args(T,A#eldap_search{scope = Scope}); +parse_search_args([{attributes, Attrs}|T],A) -> + parse_search_args(T,A#eldap_search{attributes = Attrs}); +parse_search_args([{types_only, TypesOnly}|T],A) -> + parse_search_args(T,A#eldap_search{types_only = TypesOnly}); +parse_search_args([{timeout, Timeout}|T],A) when is_integer(Timeout) -> + parse_search_args(T,A#eldap_search{timeout = Timeout}); +parse_search_args([H|_],_) -> + throw({error,{unknown_arg, H}}); +parse_search_args([],A) -> + A. + +%%% +%%% The Scope parameter +%%% +baseObject() -> baseObject. +singleLevel() -> singleLevel. +wholeSubtree() -> wholeSubtree. + +%%% +%%% Boolean filter operations +%%% +'and'(ListOfFilters) when is_list(ListOfFilters) -> {'and',ListOfFilters}. +'or'(ListOfFilters) when is_list(ListOfFilters) -> {'or', ListOfFilters}. +'not'(Filter) when is_tuple(Filter) -> {'not',Filter}. + +%%% +%%% The following Filter parameters consist of an attribute +%%% and an attribute value. Example: F("uid","tobbe") +%%% +equalityMatch(Desc, Value) -> {equalityMatch, av_assert(Desc, Value)}. +greaterOrEqual(Desc, Value) -> {greaterOrEqual, av_assert(Desc, Value)}. +lessOrEqual(Desc, Value) -> {lessOrEqual, av_assert(Desc, Value)}. +approxMatch(Desc, Value) -> {approxMatch, av_assert(Desc, Value)}. + +av_assert(Desc, Value) -> + #'AttributeValueAssertion'{attributeDesc = Desc, + assertionValue = Value}. + +%%% +%%% Filter to check for the presence of an attribute +%%% +present(Attribute) when is_list(Attribute) -> + {present, Attribute}. + + +%%% +%%% A substring filter seem to be based on a pattern: +%%% +%%% InitValue*AnyValue*FinalValue +%%% +%%% where all three parts seem to be optional (at least when +%%% talking with an OpenLDAP server). Thus, the arguments +%%% to substrings/2 looks like this: +%%% +%%% Type ::= string( <attribute> ) +%%% SubStr ::= listof( {initial,Value} | {any,Value}, {final,Value}) +%%% +%%% Example: substrings("sn",[{initial,"To"},{any,"kv"},{final,"st"}]) +%%% will match entries containing: 'sn: Tornkvist' +%%% +substrings(Type, SubStr) when is_list(Type), is_list(SubStr) -> + Ss = {'SubstringFilter_substrings',v_substr(SubStr)}, + {substrings,#'SubstringFilter'{type = Type, + substrings = Ss}}. + +%%% -------------------------------------------------------------------- +%%% Worker process. We keep track of a controlling process to +%%% be able to terminate together with it. +%%% -------------------------------------------------------------------- + +init(Hosts, Opts, Cpid) -> + Data = parse_args(Opts, Cpid, #eldap{}), + case try_connect(Hosts, Data) of + {ok,Data2} -> + send(Cpid, {ok,self()}), + put(req_timeout, Data#eldap.timeout), % kludge... + loop(Cpid, Data2); + Else -> + send(Cpid, Else), + unlink(Cpid), + exit(Else) + end. + +parse_args([{port, Port}|T], Cpid, Data) when is_integer(Port) -> + parse_args(T, Cpid, Data#eldap{port = Port}); +parse_args([{timeout, Timeout}|T], Cpid, Data) when is_integer(Timeout),Timeout>0 -> + parse_args(T, Cpid, Data#eldap{timeout = Timeout}); +parse_args([{anon_auth, true}|T], Cpid, Data) -> + parse_args(T, Cpid, Data#eldap{anon_auth = false}); +parse_args([{anon_auth, _}|T], Cpid, Data) -> + parse_args(T, Cpid, Data); +parse_args([{ssl, true}|T], Cpid, Data) -> + parse_args(T, Cpid, Data#eldap{use_tls = true}); +parse_args([{ssl, _}|T], Cpid, Data) -> + parse_args(T, Cpid, Data); +parse_args([{log, F}|T], Cpid, Data) when is_function(F) -> + parse_args(T, Cpid, Data#eldap{log = F}); +parse_args([{log, _}|T], Cpid, Data) -> + parse_args(T, Cpid, Data); +parse_args([H|_], Cpid, _) -> + send(Cpid, {error,{wrong_option,H}}), + exit(wrong_option); +parse_args([], _, Data) -> + Data. + +%%% Try to connect to the hosts in the listed order, +%%% and stop with the first one to which a successful +%%% connection is made. + +try_connect([Host|Hosts], Data) -> + TcpOpts = [{packet, asn1}, {active,false}], + case do_connect(Host, Data, TcpOpts) of + {ok,Fd} -> {ok,Data#eldap{host = Host, fd = Fd}}; + _ -> try_connect(Hosts, Data) + end; +try_connect([],_) -> + {error,"connect failed"}. + +do_connect(Host, Data, Opts) when Data#eldap.use_tls == false -> + gen_tcp:connect(Host, Data#eldap.port, Opts, Data#eldap.timeout); +do_connect(Host, Data, Opts) when Data#eldap.use_tls == true -> + ssl:connect(Host, Data#eldap.port, [{verify,0}|Opts]). + + +loop(Cpid, Data) -> + receive + + {From, {search, A}} -> + {Res,NewData} = do_search(Data, A), + send(From,Res), + loop(Cpid, NewData); + + {From, {modify, Obj, Mod}} -> + {Res,NewData} = do_modify(Data, Obj, Mod), + send(From,Res), + loop(Cpid, NewData); + + {From, {modify_dn, Obj, NewRDN, DelOldRDN, NewSup}} -> + {Res,NewData} = do_modify_dn(Data, Obj, NewRDN, DelOldRDN, NewSup), + send(From,Res), + loop(Cpid, NewData); + + {From, {add, Entry, Attrs}} -> + {Res,NewData} = do_add(Data, Entry, Attrs), + send(From,Res), + loop(Cpid, NewData); + + {From, {delete, Entry}} -> + {Res,NewData} = do_delete(Data, Entry), + send(From,Res), + loop(Cpid, NewData); + + {From, {simple_bind, Dn, Passwd}} -> + {Res,NewData} = do_simple_bind(Data, Dn, Passwd), + send(From,Res), + loop(Cpid, NewData); + + {From, {cnt_proc, NewCpid}} -> + unlink(Cpid), + send(From,ok), + ?PRINT("New Cpid is: ~p~n",[NewCpid]), + loop(NewCpid, Data); + + {_From, close} -> + unlink(Cpid), + exit(closed); + + {Cpid, 'EXIT', Reason} -> + ?PRINT("Got EXIT from Cpid, reason=~p~n",[Reason]), + exit(Reason); + + _XX -> + ?PRINT("loop got: ~p~n",[_XX]), + loop(Cpid, Data) + + end. + +%%% -------------------------------------------------------------------- +%%% bindRequest +%%% -------------------------------------------------------------------- + +%%% Authenticate ourselves to the directory using +%%% simple authentication. + +do_simple_bind(Data, anon, anon) -> %% For testing + do_the_simple_bind(Data, "", ""); +do_simple_bind(Data, Dn, _Passwd) when Dn=="",Data#eldap.anon_auth==false -> + {{error,anonymous_auth},Data}; +do_simple_bind(Data, _Dn, Passwd) when Passwd=="",Data#eldap.anon_auth==false -> + {{error,anonymous_auth},Data}; +do_simple_bind(Data, Dn, Passwd) -> + do_the_simple_bind(Data, Dn, Passwd). + +do_the_simple_bind(Data, Dn, Passwd) -> + case catch exec_simple_bind(Data#eldap{binddn = Dn, + passwd = Passwd, + id = bump_id(Data)}) of + {ok,NewData} -> {ok,NewData}; + {error,Emsg} -> {{error,Emsg},Data}; + Else -> {{error,Else},Data} + end. + +exec_simple_bind(Data) -> + Req = #'BindRequest'{version = Data#eldap.version, + name = Data#eldap.binddn, + authentication = {simple, Data#eldap.passwd}}, + log2(Data, "bind request = ~p~n", [Req]), + Reply = request(Data#eldap.fd, Data, Data#eldap.id, {bindRequest, Req}), + log2(Data, "bind reply = ~p~n", [Reply]), + exec_simple_bind_reply(Data, Reply). + +exec_simple_bind_reply(Data, {ok,Msg}) when + Msg#'LDAPMessage'.messageID == Data#eldap.id -> + case Msg#'LDAPMessage'.protocolOp of + {bindResponse, Result} -> + case Result#'BindResponse'.resultCode of + success -> {ok,Data}; + Error -> {error, Error} + end; + Other -> {error, Other} + end; +exec_simple_bind_reply(_, Error) -> + {error, Error}. + + +%%% -------------------------------------------------------------------- +%%% searchRequest +%%% -------------------------------------------------------------------- + +do_search(Data, A) -> + case catch do_search_0(Data, A) of + {error,Emsg} -> {ldap_closed_p(Data, Emsg),Data}; + {'EXIT',Error} -> {ldap_closed_p(Data, Error),Data}; + {ok,Res,Ref,NewData} -> {{ok,polish(Res, Ref)},NewData}; + Else -> {ldap_closed_p(Data, Else),Data} + end. + +%%% +%%% Polish the returned search result +%%% + +polish(Res, Ref) -> + R = polish_result(Res), + %%% No special treatment of referrals at the moment. + #eldap_search_result{entries = R, + referrals = Ref}. + +polish_result([H|T]) when is_record(H, 'SearchResultEntry') -> + ObjectName = H#'SearchResultEntry'.objectName, + F = fun({_,A,V}) -> {A,V} end, + Attrs = lists:map(F, H#'SearchResultEntry'.attributes), + [#eldap_entry{object_name = ObjectName, + attributes = Attrs}| + polish_result(T)]; +polish_result([]) -> + []. + +do_search_0(Data, A) -> + Req = #'SearchRequest'{baseObject = A#eldap_search.base, + scope = v_scope(A#eldap_search.scope), + derefAliases = neverDerefAliases, + sizeLimit = 0, % no size limit + timeLimit = v_timeout(A#eldap_search.timeout), + typesOnly = v_bool(A#eldap_search.types_only), + filter = v_filter(A#eldap_search.filter), + attributes = v_attributes(A#eldap_search.attributes) + }, + Id = bump_id(Data), + collect_search_responses(Data#eldap{id=Id}, Req, Id). + +%%% The returned answers cames in one packet per entry +%%% mixed with possible referals + +collect_search_responses(Data, Req, ID) -> + S = Data#eldap.fd, + log2(Data, "search request = ~p~n", [Req]), + send_request(S, Data, ID, {searchRequest, Req}), + Resp = recv_response(S, Data), + log2(Data, "search reply = ~p~n", [Resp]), + collect_search_responses(Data, S, ID, Resp, [], []). + +collect_search_responses(Data, S, ID, {ok,Msg}, Acc, Ref) + when is_record(Msg,'LDAPMessage') -> + case Msg#'LDAPMessage'.protocolOp of + {'searchResDone',R} when R#'LDAPResult'.resultCode == success -> + log2(Data, "search reply = searchResDone ~n", []), + {ok,Acc,Ref,Data}; + {'searchResEntry',R} when is_record(R,'SearchResultEntry') -> + Resp = recv_response(S, Data), + log2(Data, "search reply = ~p~n", [Resp]), + collect_search_responses(Data, S, ID, Resp, [R|Acc], Ref); + {'searchResRef',R} -> + %% At the moment we don't do anyting sensible here since + %% I haven't been able to trigger the server to generate + %% a response like this. + Resp = recv_response(S, Data), + log2(Data, "search reply = ~p~n", [Resp]), + collect_search_responses(Data, S, ID, Resp, Acc, [R|Ref]); + Else -> + throw({error,Else}) + end; +collect_search_responses(_, _, _, Else, _, _) -> + throw({error,Else}). + +%%% -------------------------------------------------------------------- +%%% addRequest +%%% -------------------------------------------------------------------- + +do_add(Data, Entry, Attrs) -> + case catch do_add_0(Data, Entry, Attrs) of + {error,Emsg} -> {ldap_closed_p(Data, Emsg),Data}; + {'EXIT',Error} -> {ldap_closed_p(Data, Error),Data}; + {ok,NewData} -> {ok,NewData}; + Else -> {ldap_closed_p(Data, Else),Data} + end. + +do_add_0(Data, Entry, Attrs) -> + Req = #'AddRequest'{entry = Entry, + attributes = Attrs}, + S = Data#eldap.fd, + Id = bump_id(Data), + log2(Data, "add request = ~p~n", [Req]), + Resp = request(S, Data, Id, {addRequest, Req}), + log2(Data, "add reply = ~p~n", [Resp]), + check_reply(Data#eldap{id = Id}, Resp, addResponse). + + +%%% -------------------------------------------------------------------- +%%% deleteRequest +%%% -------------------------------------------------------------------- + +do_delete(Data, Entry) -> + case catch do_delete_0(Data, Entry) of + {error,Emsg} -> {ldap_closed_p(Data, Emsg),Data}; + {'EXIT',Error} -> {ldap_closed_p(Data, Error),Data}; + {ok,NewData} -> {ok,NewData}; + Else -> {ldap_closed_p(Data, Else),Data} + end. + +do_delete_0(Data, Entry) -> + S = Data#eldap.fd, + Id = bump_id(Data), + log2(Data, "del request = ~p~n", [Entry]), + Resp = request(S, Data, Id, {delRequest, Entry}), + log2(Data, "del reply = ~p~n", [Resp]), + check_reply(Data#eldap{id = Id}, Resp, delResponse). + + +%%% -------------------------------------------------------------------- +%%% modifyRequest +%%% -------------------------------------------------------------------- + +do_modify(Data, Obj, Mod) -> + case catch do_modify_0(Data, Obj, Mod) of + {error,Emsg} -> {ldap_closed_p(Data, Emsg),Data}; + {'EXIT',Error} -> {ldap_closed_p(Data, Error),Data}; + {ok,NewData} -> {ok,NewData}; + Else -> {ldap_closed_p(Data, Else),Data} + end. + +do_modify_0(Data, Obj, Mod) -> + v_modifications(Mod), + Req = #'ModifyRequest'{object = Obj, + changes = Mod}, + S = Data#eldap.fd, + Id = bump_id(Data), + log2(Data, "modify request = ~p~n", [Req]), + Resp = request(S, Data, Id, {modifyRequest, Req}), + log2(Data, "modify reply = ~p~n", [Resp]), + check_reply(Data#eldap{id = Id}, Resp, modifyResponse). + +%%% -------------------------------------------------------------------- +%%% modifyDNRequest +%%% -------------------------------------------------------------------- + +do_modify_dn(Data, Entry, NewRDN, DelOldRDN, NewSup) -> + case catch do_modify_dn_0(Data, Entry, NewRDN, DelOldRDN, NewSup) of + {error,Emsg} -> {ldap_closed_p(Data, Emsg),Data}; + {'EXIT',Error} -> {ldap_closed_p(Data, Error),Data}; + {ok,NewData} -> {ok,NewData}; + Else -> {ldap_closed_p(Data, Else),Data} + end. + +do_modify_dn_0(Data, Entry, NewRDN, DelOldRDN, NewSup) -> + Req = #'ModifyDNRequest'{entry = Entry, + newrdn = NewRDN, + deleteoldrdn = DelOldRDN, + newSuperior = NewSup}, + S = Data#eldap.fd, + Id = bump_id(Data), + log2(Data, "modify DN request = ~p~n", [Req]), + Resp = request(S, Data, Id, {modDNRequest, Req}), + log2(Data, "modify DN reply = ~p~n", [Resp]), + check_reply(Data#eldap{id = Id}, Resp, modDNResponse). + +%%% -------------------------------------------------------------------- +%%% Send an LDAP request and receive the answer +%%% -------------------------------------------------------------------- + +request(S, Data, ID, Request) -> + send_request(S, Data, ID, Request), + recv_response(S, Data). + +send_request(S, Data, ID, Request) -> + Message = #'LDAPMessage'{messageID = ID, + protocolOp = Request}, + {ok,Bytes} = asn1rt:encode('ELDAPv3', 'LDAPMessage', Message), + case do_send(S, Data, Bytes) of + {error,Reason} -> throw({gen_tcp_error,Reason}); + Else -> Else + end. + +do_send(S, Data, Bytes) when Data#eldap.use_tls == false -> + gen_tcp:send(S, Bytes); +do_send(S, Data, Bytes) when Data#eldap.use_tls == true -> + ssl:send(S, Bytes). + +do_recv(S, Data, Len, Timeout) when Data#eldap.use_tls == false -> + gen_tcp:recv(S, Len, Timeout); +do_recv(S, Data, Len, Timeout) when Data#eldap.use_tls == true -> + ssl:recv(S, Len, Timeout). + +recv_response(S, Data) -> + Timeout = get(req_timeout), % kludge... + case do_recv(S, Data, 0, Timeout) of + {ok, Packet} -> + check_tag(Packet), + case asn1rt:decode('ELDAPv3', 'LDAPMessage', Packet) of + {ok,Resp} -> {ok,Resp}; + Error -> throw(Error) + end; + {error,Reason} -> + throw({gen_tcp_error, Reason}); + Error -> + throw(Error) + end. + +%%% Sanity check of received packet +check_tag(Data) -> + case asn1rt_ber_bin:decode_tag(b2l(Data)) of + {_Tag, Data1, _Rb} -> + case asn1rt_ber_bin:decode_length(b2l(Data1)) of + {{_Len, _Data2}, _Rb2} -> ok; + _ -> throw({error,decoded_tag_length}) + end; + _ -> throw({error,decoded_tag}) + end. + +%%% Check for expected kind of reply +check_reply(Data, {ok,Msg}, Op) when + Msg#'LDAPMessage'.messageID == Data#eldap.id -> + case Msg#'LDAPMessage'.protocolOp of + {Op, Result} -> + case Result#'LDAPResult'.resultCode of + success -> {ok,Data}; + Error -> {error, Error} + end; + Other -> {error, Other} + end; +check_reply(_, Error, _) -> + {error, Error}. + + +%%% -------------------------------------------------------------------- +%%% Verify the input data +%%% -------------------------------------------------------------------- + +v_filter({'and',L}) -> {'and',L}; +v_filter({'or', L}) -> {'or',L}; +v_filter({'not',L}) -> {'not',L}; +v_filter({equalityMatch,AV}) -> {equalityMatch,AV}; +v_filter({greaterOrEqual,AV}) -> {greaterOrEqual,AV}; +v_filter({lessOrEqual,AV}) -> {lessOrEqual,AV}; +v_filter({approxMatch,AV}) -> {approxMatch,AV}; +v_filter({present,A}) -> {present,A}; +v_filter({substrings,S}) when is_record(S,'SubstringFilter') -> {substrings,S}; +v_filter(_Filter) -> throw({error,concat(["unknown filter: ",_Filter])}). + +v_modifications(Mods) -> + F = fun({_,Op,_}) -> + case lists:member(Op,[add,delete,replace]) of + true -> true; + _ -> throw({error,{mod_operation,Op}}) + end + end, + lists:foreach(F, Mods). + +v_substr([{Key,Str}|T]) when is_list(Str),Key==initial;Key==any;Key==final -> + [{Key,Str}|v_substr(T)]; +v_substr([H|_]) -> + throw({error,{substring_arg,H}}); +v_substr([]) -> + []. +v_scope(baseObject) -> baseObject; +v_scope(singleLevel) -> singleLevel; +v_scope(wholeSubtree) -> wholeSubtree; +v_scope(_Scope) -> throw({error,concat(["unknown scope: ",_Scope])}). + +v_bool(true) -> true; +v_bool(false) -> false; +v_bool(_Bool) -> throw({error,concat(["not Boolean: ",_Bool])}). + +v_timeout(I) when is_integer(I), I>=0 -> I; +v_timeout(_I) -> throw({error,concat(["timeout not positive integer: ",_I])}). + +v_attributes(Attrs) -> + F = fun(A) when is_list(A) -> A; + (A) -> throw({error,concat(["attribute not String: ",A])}) + end, + lists:map(F,Attrs). + + +%%% -------------------------------------------------------------------- +%%% Log routines. Call a user provided log routine F. +%%% -------------------------------------------------------------------- + +%log1(Data, Str, Args) -> log(Data, Str, Args, 1). +log2(Data, Str, Args) -> log(Data, Str, Args, 2). + +log(Data, Str, Args, Level) when is_function(Data#eldap.log) -> + catch (Data#eldap.log)(Level, Str, Args); +log(_, _, _, _) -> + ok. + + +%%% -------------------------------------------------------------------- +%%% Misc. routines +%%% -------------------------------------------------------------------- + +send(To,Msg) -> To ! {self(),Msg}. +recv(From) -> receive {From,Msg} -> Msg end. + +ldap_closed_p(Data, Emsg) when Data#eldap.use_tls == true -> + %% Check if the SSL socket seems to be alive or not + case catch ssl:sockname(Data#eldap.fd) of + {error, _} -> + ssl:close(Data#eldap.fd), + {error, ldap_closed}; + {ok, _} -> + {error, Emsg}; + _ -> + %% sockname crashes if the socket pid is not alive + {error, ldap_closed} + end; +ldap_closed_p(Data, Emsg) -> + %% non-SSL socket + case inet:port(Data#eldap.fd) of + {error,_} -> {error, ldap_closed}; + _ -> {error,Emsg} + end. + +bump_id(Data) -> Data#eldap.id + 1. + + +%%% -------------------------------------------------------------------- +%%% parse_dn/1 - Implementation of RFC 2253: +%%% +%%% "UTF-8 String Representation of Distinguished Names" +%%% +%%% Test cases: +%%% +%%% The simplest case: +%%% +%%% 1> eldap:parse_dn("CN=Steve Kille,O=Isode Limited,C=GB"). +%%% {ok,[[{attribute_type_and_value,"CN","Steve Kille"}], +%%% [{attribute_type_and_value,"O","Isode Limited"}], +%%% [{attribute_type_and_value,"C","GB"}]]} +%%% +%%% The first RDN is multi-valued: +%%% +%%% 2> eldap:parse_dn("OU=Sales+CN=J. Smith,O=Widget Inc.,C=US"). +%%% {ok,[[{attribute_type_and_value,"OU","Sales"}, +%%% {attribute_type_and_value,"CN","J. Smith"}], +%%% [{attribute_type_and_value,"O","Widget Inc."}], +%%% [{attribute_type_and_value,"C","US"}]]} +%%% +%%% Quoting a comma: +%%% +%%% 3> eldap:parse_dn("CN=L. Eagle,O=Sue\\, Grabbit and Runn,C=GB"). +%%% {ok,[[{attribute_type_and_value,"CN","L. Eagle"}], +%%% [{attribute_type_and_value,"O","Sue\\, Grabbit and Runn"}], +%%% [{attribute_type_and_value,"C","GB"}]]} +%%% +%%% A value contains a carriage return: +%%% +%%% 4> eldap:parse_dn("CN=Before +%%% 4> After,O=Test,C=GB"). +%%% {ok,[[{attribute_type_and_value,"CN","Before\nAfter"}], +%%% [{attribute_type_and_value,"O","Test"}], +%%% [{attribute_type_and_value,"C","GB"}]]} +%%% +%%% 5> eldap:parse_dn("CN=Before\\0DAfter,O=Test,C=GB"). +%%% {ok,[[{attribute_type_and_value,"CN","Before\\0DAfter"}], +%%% [{attribute_type_and_value,"O","Test"}], +%%% [{attribute_type_and_value,"C","GB"}]]} +%%% +%%% An RDN in OID form: +%%% +%%% 6> eldap:parse_dn("1.3.6.1.4.1.1466.0=#04024869,O=Test,C=GB"). +%%% {ok,[[{attribute_type_and_value,"1.3.6.1.4.1.1466.0","#04024869"}], +%%% [{attribute_type_and_value,"O","Test"}], +%%% [{attribute_type_and_value,"C","GB"}]]} +%%% +%%% +%%% -------------------------------------------------------------------- + +parse_dn("") -> % empty DN string + {ok,[]}; +parse_dn([H|_] = Str) when H=/=$, -> % 1:st name-component ! + case catch parse_name(Str,[]) of + {'EXIT',Reason} -> {parse_error,internal_error,Reason}; + Else -> Else + end. + +parse_name("",Acc) -> + {ok,lists:reverse(Acc)}; +parse_name([$,|T],Acc) -> % N:th name-component ! + parse_name(T,Acc); +parse_name(Str,Acc) -> + {Rest,NameComponent} = parse_name_component(Str), + parse_name(Rest,[NameComponent|Acc]). + +parse_name_component(Str) -> + parse_name_component(Str,[]). + +parse_name_component(Str,Acc) -> + case parse_attribute_type_and_value(Str) of + {[$+|Rest], ATV} -> + parse_name_component(Rest,[ATV|Acc]); + {Rest,ATV} -> + {Rest,lists:reverse([ATV|Acc])} + end. + +parse_attribute_type_and_value(Str) -> + case parse_attribute_type(Str) of + {_Rest,[]} -> + parse_error(expecting_attribute_type,Str); + {Rest,Type} -> + Rest2 = parse_equal_sign(Rest), + {Rest3,Value} = parse_attribute_value(Rest2), + {Rest3,{attribute_type_and_value,Type,Value}} + end. + +-define(IS_ALPHA(X) , X>=$a,X=<$z;X>=$A,X=<$Z ). +-define(IS_DIGIT(X) , X>=$0,X=<$9 ). +-define(IS_SPECIAL(X) , X==$,;X==$=;X==$+;X==$<;X==$>;X==$#;X==$; ). +-define(IS_QUOTECHAR(X) , X=/=$\\,X=/=$" ). +-define(IS_STRINGCHAR(X) , + X=/=$,,X=/=$=,X=/=$+,X=/=$<,X=/=$>,X=/=$#,X=/=$;,?IS_QUOTECHAR(X) ). +-define(IS_HEXCHAR(X) , ?IS_DIGIT(X);X>=$a,X=<$f;X>=$A,X=<$F ). + +parse_attribute_type([H|T]) when ?IS_ALPHA(H) -> + %% NB: It must be an error in the RFC in the definition + %% of 'attributeType', should be: (ALPHA *keychar) + {Rest,KeyChars} = parse_keychars(T), + {Rest,[H|KeyChars]}; +parse_attribute_type([H|_] = Str) when ?IS_DIGIT(H) -> + parse_oid(Str); +parse_attribute_type(Str) -> + parse_error(invalid_attribute_type,Str). + + + +%%% Is a hexstring ! +parse_attribute_value([$#,X,Y|T]) when ?IS_HEXCHAR(X),?IS_HEXCHAR(Y) -> + {Rest,HexString} = parse_hexstring(T), + {Rest,[$#,X,Y|HexString]}; +%%% Is a "quotation-sequence" ! +parse_attribute_value([$"|T]) -> + {Rest,Quotation} = parse_quotation(T), + {Rest,[$"|Quotation]}; +%%% Is a stringchar , pair or Empty ! +parse_attribute_value(Str) -> + parse_string(Str). + +parse_hexstring(Str) -> + parse_hexstring(Str,[]). + +parse_hexstring([X,Y|T],Acc) when ?IS_HEXCHAR(X),?IS_HEXCHAR(Y) -> + parse_hexstring(T,[Y,X|Acc]); +parse_hexstring(T,Acc) -> + {T,lists:reverse(Acc)}. + +parse_quotation([$"|T]) -> % an empty: "" is ok ! + {T,[$"]}; +parse_quotation(Str) -> + parse_quotation(Str,[]). + +%%% Parse to end of quotation +parse_quotation([$"|T],Acc) -> + {T,lists:reverse([$"|Acc])}; +parse_quotation([X|T],Acc) when ?IS_QUOTECHAR(X) -> + parse_quotation(T,[X|Acc]); +parse_quotation([$\\,X|T],Acc) when ?IS_SPECIAL(X) -> + parse_quotation(T,[X,$\\|Acc]); +parse_quotation([$\\,$\\|T],Acc) -> + parse_quotation(T,[$\\,$\\|Acc]); +parse_quotation([$\\,$"|T],Acc) -> + parse_quotation(T,[$",$\\|Acc]); +parse_quotation([$\\,X,Y|T],Acc) when ?IS_HEXCHAR(X),?IS_HEXCHAR(Y) -> + parse_quotation(T,[Y,X,$\\|Acc]); +parse_quotation(T,_) -> + parse_error(expecting_double_quote_mark,T). + +parse_string(Str) -> + parse_string(Str,[]). + +parse_string("",Acc) -> + {"",lists:reverse(Acc)}; +parse_string([H|T],Acc) when ?IS_STRINGCHAR(H) -> + parse_string(T,[H|Acc]); +parse_string([$\\,X|T],Acc) when ?IS_SPECIAL(X) -> % is a pair ! + parse_string(T,[X,$\\|Acc]); +parse_string([$\\,$\\|T],Acc) -> % is a pair ! + parse_string(T,[$\\,$\\|Acc]); +parse_string([$\\,$" |T],Acc) -> % is a pair ! + parse_string(T,[$" ,$\\|Acc]); +parse_string([$\\,X,Y|T],Acc) when ?IS_HEXCHAR(X),?IS_HEXCHAR(Y) -> % is a pair! + parse_string(T,[Y,X,$\\|Acc]); +parse_string(T,Acc) -> + {T,lists:reverse(Acc)}. + +parse_equal_sign([$=|T]) -> T; +parse_equal_sign(T) -> parse_error(expecting_equal_sign,T). + +parse_keychars(Str) -> parse_keychars(Str,[]). + +parse_keychars([H|T],Acc) when ?IS_ALPHA(H) -> parse_keychars(T,[H|Acc]); +parse_keychars([H|T],Acc) when ?IS_DIGIT(H) -> parse_keychars(T,[H|Acc]); +parse_keychars([$-|T],Acc) -> parse_keychars(T,[$-|Acc]); +parse_keychars(T,Acc) -> {T,lists:reverse(Acc)}. + +parse_oid(Str) -> parse_oid(Str,[]). + +parse_oid([H,$.|T], Acc) when ?IS_DIGIT(H) -> + parse_oid(T,[$.,H|Acc]); +parse_oid([H|T], Acc) when ?IS_DIGIT(H) -> + parse_oid(T,[H|Acc]); +parse_oid(T, Acc) -> + {T,lists:reverse(Acc)}. + +parse_error(Emsg,Rest) -> + throw({parse_error,Emsg,Rest}). + + +%%% -------------------------------------------------------------------- +%%% Parse LDAP url according to RFC 2255 +%%% +%%% Test case: +%%% +%%% 2> eldap:parse_ldap_url("ldap://10.42.126.33:389/cn=Administrative%20CA,o=Post%20Danmark,c=DK?certificateRevokationList;binary"). +%%% {ok,{{10,42,126,33},389}, +%%% [[{attribute_type_and_value,"cn","Administrative%20CA"}], +%%% [{attribute_type_and_value,"o","Post%20Danmark"}], +%%% [{attribute_type_and_value,"c","DK"}]], +%%% {attributes,["certificateRevokationList;binary"]}} +%%% +%%% -------------------------------------------------------------------- + +parse_ldap_url("ldap://" ++ Rest1 = Str) -> + {Rest2,HostPort} = parse_hostport(Rest1), + %% Split the string into DN and Attributes+etc + {Sdn,Rest3} = split_string(rm_leading_slash(Rest2),$?), + case parse_dn(Sdn) of + {parse_error,internal_error,_Reason} -> + {parse_error,internal_error,{Str,[]}}; + {parse_error,Emsg,Tail} -> + Head = get_head(Str,Tail), + {parse_error,Emsg,{Head,Tail}}; + {ok,DN} -> + %% We stop parsing here for now and leave + %% 'scope', 'filter' and 'extensions' to + %% be implemented later if needed. + {_Rest4,Attributes} = parse_attributes(Rest3), + {ok,HostPort,DN,Attributes} + end. + +rm_leading_slash([$/|Tail]) -> Tail; +rm_leading_slash(Tail) -> Tail. + +parse_attributes([$?|Tail]) -> + case split_string(Tail,$?) of + {[],Attributes} -> + {[],{attributes,string:tokens(Attributes,",")}}; + {Attributes,Rest} -> + {Rest,{attributes,string:tokens(Attributes,",")}} + end. + +parse_hostport(Str) -> + {HostPort,Rest} = split_string(Str,$/), + case split_string(HostPort,$:) of + {Shost,[]} -> + {Rest,{parse_host(Rest,Shost),?LDAP_PORT}}; + {Shost,[$:|Sport]} -> + {Rest,{parse_host(Rest,Shost), + parse_port(Rest,Sport)}} + end. + +parse_port(Rest,Sport) -> + case list_to_integer(Sport) of + Port when is_integer(Port) -> Port; + _ -> parse_error(parsing_port,Rest) + end. + +parse_host(Rest,Shost) -> + case catch validate_host(Shost) of + {parse_error,Emsg,_} -> parse_error(Emsg,Rest); + Host -> Host + end. + +validate_host(Shost) -> + case inet_parse:address(Shost) of + {ok,Host} -> Host; + _ -> + case inet_parse:domain(Shost) of + true -> Shost; + _ -> parse_error(parsing_host,Shost) + end + end. + + +split_string(Str,Key) -> + Pred = fun(X) when X==Key -> false; (_) -> true end, + lists:splitwith(Pred, Str). + +get_head(Str,Tail) -> + get_head(Str,Tail,[]). + +%%% Should always succeed ! +get_head([H|Tail],Tail,Rhead) -> lists:reverse([H|Rhead]); +get_head([H|Rest],Tail,Rhead) -> get_head(Rest,Tail,[H|Rhead]). + +b2l(B) when is_binary(B) -> B; +b2l(L) when is_list(L) -> list_to_binary(L). + diff --git a/lib/eldap/src/eldap_app.erl b/lib/eldap/src/eldap_app.erl new file mode 100644 index 0000000000..fa253664ea --- /dev/null +++ b/lib/eldap/src/eldap_app.erl @@ -0,0 +1,16 @@ +-module(eldap_app). + +-behaviour(application). + +%% Application callbacks +-export([start/2, stop/1]). + +%% =================================================================== +%% Application callbacks +%% =================================================================== + +start(_StartType, _StartArgs) -> + eldap_sup:start_link(). + +stop(_State) -> + ok. diff --git a/lib/eldap/src/eldap_fsm.erl b/lib/eldap/src/eldap_fsm.erl new file mode 100644 index 0000000000..b757d3d54f --- /dev/null +++ b/lib/eldap/src/eldap_fsm.erl @@ -0,0 +1,946 @@ +-module(eldap_fsm). +%%% -------------------------------------------------------------------- +%%% Created: 12 Oct 2000 by Tobbe +%%% Function: Erlang client LDAP implementation according RFC 2251. +%%% The interface is based on RFC 1823, and +%%% draft-ietf-asid-ldap-c-api-00.txt +%%% +%%% Copyright (C) 2000 Torbjn Tnkvist +%%% Copyright (c) 2010 Torbjorn Tornkvist <[email protected]> +%%% See MIT-LICENSE at the top dir for licensing information. +%%% +%%% Modified by Sean Hinde <[email protected]> 7th Dec 2000 +%%% Turned into gen_fsm, made non-blocking, added timers etc to support this. +%%% Now has the concept of a name (string() or atom()) per instance which allows +%%% multiple users to call by name if so desired. +%%% +%%% Can be configured with start_link parameters or use a config file to get +%%% host to connect to, dn, password, log function etc. +%%% -------------------------------------------------------------------- + + +%%%---------------------------------------------------------------------- +%%% LDAP Client state machine. +%%% Possible states are: +%%% connecting - actually disconnected, but retrying periodically +%%% wait_bind_response - connected and sent bind request +%%% active - bound to LDAP Server and ready to handle commands +%%%---------------------------------------------------------------------- + +%%-compile(export_all). +%%-export([Function/Arity, ...]). + +-behaviour(gen_fsm). + +%% External exports +-export([start_link/1, start_link/5, start_link/6]). + +-export([baseObject/0,singleLevel/0,wholeSubtree/0,close/1, + equalityMatch/2,greaterOrEqual/2,lessOrEqual/2, + approxMatch/2,search/2,substrings/2,present/1, + 'and'/1,'or'/1,'not'/1,modify/3, mod_add/2, mod_delete/2, + mod_replace/2, add/3, delete/2, modify_dn/5]). +-export([debug_level/2, get_status/1]). + +%% gen_fsm callbacks +-export([init/1, connecting/2, + connecting/3, wait_bind_response/3, active/3, handle_event/3, + handle_sync_event/4, handle_info/3, terminate/3, code_change/4]). + + +-import(lists,[concat/1]). + +-include("ELDAPv3.hrl"). +-include("eldap.hrl"). + +-define(LDAP_VERSION, 3). +-define(RETRY_TIMEOUT, 5000). +-define(BIND_TIMEOUT, 10000). +-define(CMD_TIMEOUT, 5000). +-define(MAX_TRANSACTION_ID, 65535). +-define(MIN_TRANSACTION_ID, 0). + +-record(eldap, {version = ?LDAP_VERSION, + hosts, % Possible hosts running LDAP servers + host = null, % Connected Host LDAP server + port = 389 , % The LDAP server port + fd = null, % Socket filedescriptor. + rootdn = "", % Name of the entry to bind as + passwd, % Password for (above) entry + id = 0, % LDAP Request ID + log, % User provided log function + bind_timer, % Ref to bind timeout + dict, % dict holding operation params and results + debug_level % Integer debug/logging level + }). + +%%%---------------------------------------------------------------------- +%%% API +%%%---------------------------------------------------------------------- +start_link(Name) -> + Reg_name = list_to_atom("eldap_" ++ Name), + gen_fsm:start_link({local, Reg_name}, ?MODULE, [], []). + +start_link(Name, Hosts, Port, Rootdn, Passwd) -> + Log = fun(_N, Fmt, Args) -> io:format("---- " ++ Fmt, [Args]) end, + Reg_name = list_to_atom("eldap_" ++ Name), + gen_fsm:start_link({local, Reg_name}, ?MODULE, {Hosts, Port, Rootdn, Passwd, Log}, []). + +start_link(Name, Hosts, Port, Rootdn, Passwd, Log) -> + Reg_name = list_to_atom("eldap_" ++ Name), + gen_fsm:start_link({local, Reg_name}, ?MODULE, {Hosts, Port, Rootdn, Passwd, Log}, []). + +%%% -------------------------------------------------------------------- +%%% Set Debug Level. 0 - none, 1 - errors, 2 - ldap events +%%% -------------------------------------------------------------------- +debug_level(Handle, N) when is_integer(N) -> + Handle1 = get_handle(Handle), + gen_fsm:sync_send_all_state_event(Handle1, {debug_level,N}). + +%%% -------------------------------------------------------------------- +%%% Get status of connection. +%%% -------------------------------------------------------------------- +get_status(Handle) -> + Handle1 = get_handle(Handle), + gen_fsm:sync_send_all_state_event(Handle1, get_status). + +%%% -------------------------------------------------------------------- +%%% Shutdown connection (and process) asynchronous. +%%% -------------------------------------------------------------------- +close(Handle) -> + Handle1 = get_handle(Handle), + gen_fsm:send_all_state_event(Handle1, close). + +%%% -------------------------------------------------------------------- +%%% Add an entry. The entry field MUST NOT exist for the AddRequest +%%% to succeed. The parent of the entry MUST exist. +%%% Example: +%%% +%%% add(Handle, +%%% "cn=Bill Valentine, ou=people, o=Bluetail AB, dc=bluetail, dc=com", +%%% [{"objectclass", ["person"]}, +%%% {"cn", ["Bill Valentine"]}, +%%% {"sn", ["Valentine"]}, +%%% {"telephoneNumber", ["545 555 00"]}] +%%% ) +%%% -------------------------------------------------------------------- +add(Handle, Entry, Attributes) when is_list(Entry),is_list(Attributes) -> + Handle1 = get_handle(Handle), + gen_fsm:sync_send_event(Handle1, {add, Entry, add_attrs(Attributes)}). + +%%% Do sanity check ! +add_attrs(Attrs) -> + F = fun({Type,Vals}) when is_list(Type),is_list(Vals) -> + %% Confused ? Me too... :-/ + {'AddRequest_attributes',Type, Vals} + end, + case catch lists:map(F, Attrs) of + {'EXIT', _} -> throw({error, attribute_values}); + Else -> Else + end. + + +%%% -------------------------------------------------------------------- +%%% Delete an entry. The entry consists of the DN of +%%% the entry to be deleted. +%%% Example: +%%% +%%% delete(Handle, +%%% "cn=Bill Valentine, ou=people, o=Bluetail AB, dc=bluetail, dc=com" +%%% ) +%%% -------------------------------------------------------------------- +delete(Handle, Entry) when is_list(Entry) -> + Handle1 = get_handle(Handle), + gen_fsm:sync_send_event(Handle1, {delete, Entry}). + +%%% -------------------------------------------------------------------- +%%% Modify an entry. Given an entry a number of modification +%%% operations can be performed as one atomic operation. +%%% Example: +%%% +%%% modify(Handle, +%%% "cn=Torbjorn Tornkvist, ou=people, o=Bluetail AB, dc=bluetail, dc=com", +%%% [replace("telephoneNumber", ["555 555 00"]), +%%% add("description", ["LDAP hacker"])] +%%% ) +%%% -------------------------------------------------------------------- +modify(Handle, Object, Mods) when is_list(Object), is_list(Mods) -> + Handle1 = get_handle(Handle), + gen_fsm:sync_send_event(Handle1, {modify, Object, Mods}). + +%%% +%%% Modification operations. +%%% Example: +%%% replace("telephoneNumber", ["555 555 00"]) +%%% +mod_add(Type, Values) when is_list(Type), is_list(Values) -> m(add, Type, Values). +mod_delete(Type, Values) when is_list(Type), is_list(Values) -> m(delete, Type, Values). +mod_replace(Type, Values) when is_list(Type), is_list(Values) -> m(replace, Type, Values). + +m(Operation, Type, Values) -> + #'ModifyRequest_changes_SEQOF'{ + operation = Operation, + modification = #'PartialAttribute'{ + type = Type, + vals = Values}}. + +%%% -------------------------------------------------------------------- +%%% Modify an entry. Given an entry a number of modification +%%% operations can be performed as one atomic operation. +%%% Example: +%%% +%%% modify_dn(Handle, +%%% "cn=Bill Valentine, ou=people, o=Bluetail AB, dc=bluetail, dc=com", +%%% "cn=Ben Emerson", +%%% true, +%%% "" +%%% ) +%%% -------------------------------------------------------------------- +modify_dn(Handle, Entry, NewRDN, DelOldRDN, NewSup) + when is_list(Entry), is_list(NewRDN),is_atom(DelOldRDN),is_list(NewSup) -> + Handle1 = get_handle(Handle), + gen_fsm:sync_send_event(Handle1, {modify_dn, Entry, NewRDN, bool_p(DelOldRDN), optional(NewSup)}). + +%%% Sanity checks ! + +bool_p(Bool) when Bool==true;Bool==false -> Bool. + +optional([]) -> asn1_NOVALUE; +optional(Value) -> Value. + +%%% -------------------------------------------------------------------- +%%% Synchronous search of the Directory returning a +%%% requested set of attributes. +%%% +%%% Example: +%%% +%%% Filter = eldap:substrings("sn", [{any,"o"}]), +%%% eldap:search(S, [{base, "dc=bluetail, dc=com"}, +%%% {filter, Filter}, +%%% {attributes,["cn"]}])), +%%% +%%% Returned result: {ok, #eldap_search_result{}} +%%% +%%% Example: +%%% +%%% {ok,{eldap_search_result, +%%% [{eldap_entry, +%%% "cn=Magnus Froberg, dc=bluetail, dc=com", +%%% [{"cn",["Magnus Froberg"]}]}, +%%% {eldap_entry, +%%% "cn=Torbjorn Tornkvist, dc=bluetail, dc=com", +%%% [{"cn",["Torbjorn Tornkvist"]}]}], +%%% []}} +%%% +%%% -------------------------------------------------------------------- +search(Handle, A) when is_record(A, eldap_search) -> + call_search(Handle, A); +search(Handle, L) when is_list(Handle), is_list(L) -> + case catch parse_search_args(L) of + {error, Emsg} -> {error, Emsg}; + {'EXIT', Emsg} -> {error, Emsg}; + A when is_record(A, eldap_search) -> call_search(Handle, A) + end. + +call_search(Handle, A) -> + Handle1 = get_handle(Handle), + gen_fsm:sync_send_event(Handle1, {search, A}). + +parse_search_args(Args) -> + parse_search_args(Args, #eldap_search{scope = wholeSubtree}). + +parse_search_args([{base, Base}|T],A) -> + parse_search_args(T,A#eldap_search{base = Base}); +parse_search_args([{filter, Filter}|T],A) -> + parse_search_args(T,A#eldap_search{filter = Filter}); +parse_search_args([{scope, Scope}|T],A) -> + parse_search_args(T,A#eldap_search{scope = Scope}); +parse_search_args([{attributes, Attrs}|T],A) -> + parse_search_args(T,A#eldap_search{attributes = Attrs}); +parse_search_args([{types_only, TypesOnly}|T],A) -> + parse_search_args(T,A#eldap_search{types_only = TypesOnly}); +parse_search_args([{timeout, Timeout}|T],A) when is_integer(Timeout) -> + parse_search_args(T,A#eldap_search{timeout = Timeout}); +parse_search_args([H|_T],_A) -> + throw({error,{unknown_arg, H}}); +parse_search_args([],A) -> + A. + +%%% +%%% The Scope parameter +%%% +baseObject() -> baseObject. +singleLevel() -> singleLevel. +wholeSubtree() -> wholeSubtree. + +%%% +%%% Boolean filter operations +%%% +'and'(ListOfFilters) when is_list(ListOfFilters) -> {'and',ListOfFilters}. +'or'(ListOfFilters) when is_list(ListOfFilters) -> {'or', ListOfFilters}. +'not'(Filter) when is_tuple(Filter) -> {'not',Filter}. + +%%% +%%% The following Filter parameters consist of an attribute +%%% and an attribute value. Example: F("uid","tobbe") +%%% +equalityMatch(Desc, Value) -> {equalityMatch, av_assert(Desc, Value)}. +greaterOrEqual(Desc, Value) -> {greaterOrEqual, av_assert(Desc, Value)}. +lessOrEqual(Desc, Value) -> {lessOrEqual, av_assert(Desc, Value)}. +approxMatch(Desc, Value) -> {approxMatch, av_assert(Desc, Value)}. + +av_assert(Desc, Value) -> + #'AttributeValueAssertion'{attributeDesc = Desc, + assertionValue = Value}. + +%%% +%%% Filter to check for the presence of an attribute +%%% +present(Attribute) when is_list(Attribute) -> + {present, Attribute}. + + +%%% +%%% A substring filter seem to be based on a pattern: +%%% +%%% InitValue*AnyValue*FinalValue +%%% +%%% where all three parts seem to be optional (at least when +%%% talking with an OpenLDAP server). Thus, the arguments +%%% to substrings/2 looks like this: +%%% +%%% Type ::= string( <attribute> ) +%%% SubStr ::= listof( {initial,Value} | {any,Value}, {final,Value}) +%%% +%%% Example: substrings("sn",[{initial,"To"},{any,"kv"},{final,"st"}]) +%%% will match entries containing: 'sn: Tornkvist' +%%% +substrings(Type, SubStr) when is_list(Type), is_list(SubStr) -> + Ss = {'SubstringFilter_substrings',v_substr(SubStr)}, + {substrings,#'SubstringFilter'{type = Type, + substrings = Ss}}. + + +get_handle(Pid) when is_pid(Pid) -> Pid; +get_handle(Atom) when is_atom(Atom) -> Atom; +get_handle(Name) when is_list(Name) -> list_to_atom("eldap_" ++ Name). +%%%---------------------------------------------------------------------- +%%% Callback functions from gen_fsm +%%%---------------------------------------------------------------------- + +%%---------------------------------------------------------------------- +%% Func: init/1 +%% Returns: {ok, StateName, StateData} | +%% {ok, StateName, StateData, Timeout} | +%% ignore | +%% {stop, StopReason} +%% I use the trick of setting a timeout of 0 to pass control into the +%% process. +%%---------------------------------------------------------------------- +init([]) -> + case get_config() of + {ok, Hosts, Rootdn, Passwd, Log} -> + init({Hosts, Rootdn, Passwd, Log}); + {error, Reason} -> + {stop, Reason} + end; +init({Hosts, Port, Rootdn, Passwd, Log}) -> + {ok, connecting, #eldap{hosts = Hosts, + port = Port, + rootdn = Rootdn, + passwd = Passwd, + id = 0, + log = Log, + dict = dict:new(), + debug_level = 0}, 0}. + +%%---------------------------------------------------------------------- +%% Func: StateName/2 +%% Called when gen_fsm:send_event/2,3 is invoked (async) +%% Returns: {next_state, NextStateName, NextStateData} | +%% {next_state, NextStateName, NextStateData, Timeout} | +%% {stop, Reason, NewStateData} +%%---------------------------------------------------------------------- +connecting(timeout, S) -> + {ok, NextState, NewS} = connect_bind(S), + {next_state, NextState, NewS}. + +%%---------------------------------------------------------------------- +%% Func: StateName/3 +%% Called when gen_fsm:sync_send_event/2,3 is invoked. +%% Returns: {next_state, NextStateName, NextStateData} | +%% {next_state, NextStateName, NextStateData, Timeout} | +%% {reply, Reply, NextStateName, NextStateData} | +%% {reply, Reply, NextStateName, NextStateData, Timeout} | +%% {stop, Reason, NewStateData} | +%% {stop, Reason, Reply, NewStateData} +%%---------------------------------------------------------------------- +connecting(_Event, _From, S) -> + Reply = {error, connecting}, + {reply, Reply, connecting, S}. + +wait_bind_response(_Event, _From, S) -> + Reply = {error, wait_bind_response}, + {reply, Reply, wait_bind_response, S}. + +active(Event, From, S) -> + case catch send_command(Event, From, S) of + {ok, NewS} -> + {next_state, active, NewS}; + {error, Reason} -> + {reply, {error, Reason}, active, S}; + {'EXIT', Reason} -> + {reply, {error, Reason}, active, S} + end. + +%%---------------------------------------------------------------------- +%% Func: handle_event/3 +%% Called when gen_fsm:send_all_state_event/2 is invoked. +%% Returns: {next_state, NextStateName, NextStateData} | +%% {next_state, NextStateName, NextStateData, Timeout} | +%% {stop, Reason, NewStateData} +%%---------------------------------------------------------------------- +handle_event(close, _StateName, S) -> + gen_tcp:close(S#eldap.fd), + {stop, closed, S}; + +handle_event(_Event, StateName, S) -> + {next_state, StateName, S}. + +%%---------------------------------------------------------------------- +%% Func: handle_sync_event/4 +%% Called when gen_fsm:sync_send_all_state_event/2,3 is invoked +%% Returns: {next_state, NextStateName, NextStateData} | +%% {next_state, NextStateName, NextStateData, Timeout} | +%% {reply, Reply, NextStateName, NextStateData} | +%% {reply, Reply, NextStateName, NextStateData, Timeout} | +%% {stop, Reason, NewStateData} | +%% {stop, Reason, Reply, NewStateData} +%%---------------------------------------------------------------------- +handle_sync_event({debug_level, N}, _From, StateName, S) -> + {reply, ok, StateName, S#eldap{debug_level = N}}; + +handle_sync_event(_Event, _From, StateName, S) -> + {reply, {StateName, S}, StateName, S}. + +%% handle_sync_event(_Event, _From, StateName, S) -> +%% Reply = ok, +%% {reply, Reply, StateName, S}. + +%%---------------------------------------------------------------------- +%% Func: handle_info/3 +%% Returns: {next_state, NextStateName, NextStateData} | +%% {next_state, NextStateName, NextStateData, Timeout} | +%% {stop, Reason, NewStateData} +%%---------------------------------------------------------------------- + +%% +%% Packets arriving in various states +%% +handle_info({tcp, _Socket, Data}, connecting, S) -> + log1("eldap. tcp packet received when disconnected!~n~p~n", [Data], S), + {next_state, connecting, S}; + +handle_info({tcp, _Socket, Data}, wait_bind_response, S) -> + cancel_timer(S#eldap.bind_timer), + case catch recvd_wait_bind_response(Data, S) of + bound -> {next_state, active, S}; + {fail_bind, _Reason} -> close_and_retry(S), + {next_state, connecting, S#eldap{fd = null}}; + {'EXIT', _Reason} -> close_and_retry(S), + {next_state, connecting, S#eldap{fd = null}}; + {error, _Reason} -> close_and_retry(S), + {next_state, connecting, S#eldap{fd = null}} + end; + +handle_info({tcp, _Socket, Data}, active, S) -> + case catch recvd_packet(Data, S) of + {reply, Reply, To, NewS} -> gen_fsm:reply(To, Reply), + {next_state, active, NewS}; + {ok, NewS} -> {next_state, active, NewS}; + {'EXIT', _Reason} -> {next_state, active, S}; + {error, _Reason} -> {next_state, active, S} + end; + +handle_info({tcp_closed, _Socket}, _All_fsm_states, S) -> + F = fun(_Id, [{Timer, From, _Name}|_Res]) -> + gen_fsm:reply(From, {error, tcp_closed}), + cancel_timer(Timer) + end, + dict:map(F, S#eldap.dict), + retry_connect(), + {next_state, connecting, S#eldap{fd = null, + dict = dict:new()}}; + +handle_info({tcp_error, _Socket, Reason}, Fsm_state, S) -> + log1("eldap received tcp_error: ~p~nIn State: ~p~n", [Reason, Fsm_state], S), + {next_state, Fsm_state, S}; +%% +%% Timers +%% +handle_info({timeout, Timer, {cmd_timeout, Id}}, active, S) -> + case cmd_timeout(Timer, Id, S) of + {reply, To, Reason, NewS} -> gen_fsm:reply(To, Reason), + {next_state, active, NewS}; + {error, _Reason} -> {next_state, active, S} + end; + +handle_info({timeout, retry_connect}, connecting, S) -> + {ok, NextState, NewS} = connect_bind(S), + {next_state, NextState, NewS}; + +handle_info({timeout, _Timer, bind_timeout}, wait_bind_response, S) -> + close_and_retry(S), + {next_state, connecting, S#eldap{fd = null}}; + +%% +%% Make sure we don't fill the message queue with rubbish +%% +handle_info(Info, StateName, S) -> + log1("eldap. Unexpected Info: ~p~nIn state: ~p~n when StateData is: ~p~n", + [Info, StateName, S], S), + {next_state, StateName, S}. + +%%---------------------------------------------------------------------- +%% Func: terminate/3 +%% Purpose: Shutdown the fsm +%% Returns: any +%%---------------------------------------------------------------------- +terminate(_Reason, _StateName, _StatData) -> + ok. + +%%---------------------------------------------------------------------- +%% Func: code_change/4 +%% Purpose: Convert process state when code is changed +%% Returns: {ok, NewState, NewStateData} +%%---------------------------------------------------------------------- +code_change(_OldVsn, StateName, S, _Extra) -> + {ok, StateName, S}. + +%%%---------------------------------------------------------------------- +%%% Internal functions +%%%---------------------------------------------------------------------- +send_command(Command, From, S) -> + Id = bump_id(S), + {Name, Request} = gen_req(Command), + Message = #'LDAPMessage'{messageID = Id, + protocolOp = {Name, Request}}, + log2("~p~n",[{Name, Request}], S), + {ok, Bytes} = asn1rt:encode('ELDAPv3', 'LDAPMessage', Message), + ok = gen_tcp:send(S#eldap.fd, Bytes), + Timer = erlang:start_timer(?CMD_TIMEOUT, self(), {cmd_timeout, Id}), + New_dict = dict:store(Id, [{Timer, From, Name}], S#eldap.dict), + {ok, S#eldap{id = Id, + dict = New_dict}}. + +gen_req({search, A}) -> + {searchRequest, + #'SearchRequest'{baseObject = A#eldap_search.base, + scope = v_scope(A#eldap_search.scope), + derefAliases = neverDerefAliases, + sizeLimit = 0, % no size limit + timeLimit = v_timeout(A#eldap_search.timeout), + typesOnly = v_bool(A#eldap_search.types_only), + filter = v_filter(A#eldap_search.filter), + attributes = v_attributes(A#eldap_search.attributes) + }}; +gen_req({add, Entry, Attrs}) -> + {addRequest, + #'AddRequest'{entry = Entry, + attributes = Attrs}}; +gen_req({delete, Entry}) -> + {delRequest, Entry}; +gen_req({modify, Obj, Mod}) -> + v_modifications(Mod), + {modifyRequest, + #'ModifyRequest'{object = Obj, + changes = Mod}}; +gen_req({modify_dn, Entry, NewRDN, DelOldRDN, NewSup}) -> + {modDNRequest, + #'ModifyDNRequest'{entry = Entry, + newrdn = NewRDN, + deleteoldrdn = DelOldRDN, + newSuperior = NewSup}}. + +%%----------------------------------------------------------------------- +%% recvd_packet +%% Deals with incoming packets in the active state +%% Will return one of: +%% {ok, NewS} - Don't reply to client yet as this is part of a search +%% result and we haven't got all the answers yet. +%% {reply, Result, From, NewS} - Reply with result to client From +%% {error, Reason} +%% {'EXIT', Reason} - Broke +%%----------------------------------------------------------------------- +recvd_packet(Pkt, S) -> + check_tag(Pkt), + case asn1rt:decode('ELDAPv3', 'LDAPMessage', Pkt) of + {ok,Msg} -> + Op = Msg#'LDAPMessage'.protocolOp, + log2("~p~n",[Op], S), + Dict = S#eldap.dict, + Id = Msg#'LDAPMessage'.messageID, + {Timer, From, Name, Result_so_far} = get_op_rec(Id, Dict), + case {Name, Op} of + {searchRequest, {searchResEntry, R}} when + is_record(R,'SearchResultEntry') -> + New_dict = dict:append(Id, R, Dict), + {ok, S#eldap{dict = New_dict}}; + {searchRequest, {searchResDone, Result}} -> + case Result#'LDAPResult'.resultCode of + success -> + {Res, Ref} = polish(Result_so_far), + New_dict = dict:erase(Id, Dict), + cancel_timer(Timer), + {reply, #eldap_search_result{entries = Res, + referrals = Ref}, From, + S#eldap{dict = New_dict}}; + Reason -> + New_dict = dict:erase(Id, Dict), + cancel_timer(Timer), + {reply, {error, Reason}, From, S#eldap{dict = New_dict}} + end; + {searchRequest, {searchResRef, R}} -> + New_dict = dict:append(Id, R, Dict), + {ok, S#eldap{dict = New_dict}}; + {addRequest, {addResponse, Result}} -> + New_dict = dict:erase(Id, Dict), + cancel_timer(Timer), + Reply = check_reply(Result, From), + {reply, Reply, From, S#eldap{dict = New_dict}}; + {delRequest, {delResponse, Result}} -> + New_dict = dict:erase(Id, Dict), + cancel_timer(Timer), + Reply = check_reply(Result, From), + {reply, Reply, From, S#eldap{dict = New_dict}}; + {modifyRequest, {modifyResponse, Result}} -> + New_dict = dict:erase(Id, Dict), + cancel_timer(Timer), + Reply = check_reply(Result, From), + {reply, Reply, From, S#eldap{dict = New_dict}}; + {modDNRequest, {modDNResponse, Result}} -> + New_dict = dict:erase(Id, Dict), + cancel_timer(Timer), + Reply = check_reply(Result, From), + {reply, Reply, From, S#eldap{dict = New_dict}}; + {OtherName, OtherResult} -> + New_dict = dict:erase(Id, Dict), + cancel_timer(Timer), + {reply, {error, {invalid_result, OtherName, OtherResult}}, + From, S#eldap{dict = New_dict}} + end; + Error -> Error + end. + +check_reply(#'LDAPResult'{resultCode = success}, _From) -> + ok; +check_reply(#'LDAPResult'{resultCode = Reason}, _From) -> + {error, Reason}; +check_reply(Other, _From) -> + {error, Other}. + +get_op_rec(Id, Dict) -> + case dict:find(Id, Dict) of + {ok, [{Timer, From, Name}|Res]} -> + {Timer, From, Name, Res}; + error -> + throw({error, unkown_id}) + end. + +%%----------------------------------------------------------------------- +%% recvd_wait_bind_response packet +%% Deals with incoming packets in the wait_bind_response state +%% Will return one of: +%% bound - Success - move to active state +%% {fail_bind, Reason} - Failed +%% {error, Reason} +%% {'EXIT', Reason} - Broken packet +%%----------------------------------------------------------------------- +recvd_wait_bind_response(Pkt, S) -> + check_tag(Pkt), + case asn1rt:decode('ELDAPv3', 'LDAPMessage', Pkt) of + {ok,Msg} -> + log2("~p", [Msg], S), + check_id(S#eldap.id, Msg#'LDAPMessage'.messageID), + case Msg#'LDAPMessage'.protocolOp of + {bindResponse, Result} -> + case Result#'LDAPResult'.resultCode of + success -> bound; + Error -> {fail_bind, Error} + end + end; + Else -> + {fail_bind, Else} + end. + +check_id(Id, Id) -> ok; +check_id(_, _) -> throw({error, wrong_bind_id}). + +%%----------------------------------------------------------------------- +%% General Helpers +%%----------------------------------------------------------------------- + +cancel_timer(Timer) -> + erlang:cancel_timer(Timer), + receive + {timeout, Timer, _} -> + ok + after 0 -> + ok + end. + + +%%% Sanity check of received packet +check_tag(Data) -> + case asn1rt_ber:decode_tag(Data) of + {_Tag, Data1, _Rb} -> + case asn1rt_ber:decode_length(Data1) of + {{_Len,_Data2}, _Rb2} -> ok; + _ -> throw({error,decoded_tag_length}) + end; + _ -> throw({error,decoded_tag}) + end. + +close_and_retry(S) -> + gen_tcp:close(S#eldap.fd), + retry_connect(). + +retry_connect() -> + erlang:send_after(?RETRY_TIMEOUT, self(), + {timeout, retry_connect}). + + +%%----------------------------------------------------------------------- +%% Sort out timed out commands +%%----------------------------------------------------------------------- +cmd_timeout(Timer, Id, S) -> + Dict = S#eldap.dict, + case dict:find(Id, Dict) of + {ok, [{Id, Timer, From, Name}|Res]} -> + case Name of + searchRequest -> + {Res1, Ref1} = polish(Res), + New_dict = dict:erase(Id, Dict), + {reply, From, {timeout, + #eldap_search_result{entries = Res1, + referrals = Ref1}}, + S#eldap{dict = New_dict}}; + _Others -> + New_dict = dict:erase(Id, Dict), + {reply, From, {error, timeout}, S#eldap{dict = New_dict}} + end; + error -> + {error, timed_out_cmd_not_in_dict} + end. + +%%----------------------------------------------------------------------- +%% Common stuff for results +%%----------------------------------------------------------------------- +%%% +%%% Polish the returned search result +%%% + +polish(Entries) -> + polish(Entries, [], []). + +polish([H|T], Res, Ref) when is_record(H, 'SearchResultEntry') -> + ObjectName = H#'SearchResultEntry'.objectName, + F = fun({_,A,V}) -> {A,V} end, + Attrs = lists:map(F, H#'SearchResultEntry'.attributes), + polish(T, [#eldap_entry{object_name = ObjectName, + attributes = Attrs}|Res], Ref); +polish([H|T], Res, Ref) -> % No special treatment of referrals at the moment. + polish(T, Res, [H|Ref]); +polish([], Res, Ref) -> + {Res, Ref}. + +%%----------------------------------------------------------------------- +%% Connect to next server in list and attempt to bind to it. +%%----------------------------------------------------------------------- +connect_bind(S) -> + Host = next_host(S#eldap.host, S#eldap.hosts), + TcpOpts = [{packet, asn1}, {active, true}], + case gen_tcp:connect(Host, S#eldap.port, TcpOpts) of + {ok, Socket} -> + case bind_request(Socket, S) of + {ok, NewS} -> + Timer = erlang:start_timer(?BIND_TIMEOUT, self(), + {timeout, bind_timeout}), + {ok, wait_bind_response, NewS#eldap{fd = Socket, + host = Host, + bind_timer = Timer}}; + {error, _Reason} -> + gen_tcp:close(Socket), + erlang:send_after(?RETRY_TIMEOUT, self(), + {timeout, retry_connect}), + {ok, connecting, S#eldap{host = Host}} + end; + {error, _Reason} -> + erlang:send_after(?RETRY_TIMEOUT, self(), + {timeout, retry_connect}), + {ok, connecting, S#eldap{host = Host}} + end. + +bind_request(Socket, S) -> + Id = bump_id(S), + Req = #'BindRequest'{version = S#eldap.version, + name = S#eldap.rootdn, + authentication = {simple, S#eldap.passwd}}, + Message = #'LDAPMessage'{messageID = Id, + protocolOp = {bindRequest, Req}}, + log2("Message:~p~n",[Message], S), + {ok, Bytes} = asn1rt:encode('ELDAPv3', 'LDAPMessage', Message), + ok = gen_tcp:send(Socket, Bytes), + {ok, S#eldap{id = Id}}. + +%% Given last tried Server, find next one to try +next_host(null, [H|_]) -> H; % First time, take first +next_host(Host, Hosts) -> % Find next in turn + next_host(Host, Hosts, Hosts). + +next_host(Host, [Host], Hosts) -> hd(Hosts); % Wrap back to first +next_host(Host, [Host|Tail], _Hosts) -> hd(Tail); % Take next +next_host(_Host, [], Hosts) -> hd(Hosts); % Never connected before? (shouldn't happen) +next_host(Host, [_H|T], Hosts) -> next_host(Host, T, Hosts). + + +%%% -------------------------------------------------------------------- +%%% Verify the input data +%%% -------------------------------------------------------------------- + +v_filter({'and',L}) -> {'and',L}; +v_filter({'or', L}) -> {'or',L}; +v_filter({'not',L}) -> {'not',L}; +v_filter({equalityMatch,AV}) -> {equalityMatch,AV}; +v_filter({greaterOrEqual,AV}) -> {greaterOrEqual,AV}; +v_filter({lessOrEqual,AV}) -> {lessOrEqual,AV}; +v_filter({approxMatch,AV}) -> {approxMatch,AV}; +v_filter({present,A}) -> {present,A}; +v_filter({substrings,S}) when is_record(S,'SubstringFilter') -> {substrings,S}; +v_filter(_Filter) -> throw({error,concat(["unknown filter: ",_Filter])}). + +v_modifications(Mods) -> + F = fun({_,Op,_}) -> + case lists:member(Op,[add,delete,replace]) of + true -> true; + _ -> throw({error,{mod_operation,Op}}) + end + end, + lists:foreach(F, Mods). + +v_substr([{Key,Str}|T]) when is_list(Str),Key==initial;Key==any;Key==final -> + [{Key,Str}|v_substr(T)]; +v_substr([H|_T]) -> + throw({error,{substring_arg,H}}); +v_substr([]) -> + []. +v_scope(baseObject) -> baseObject; +v_scope(singleLevel) -> singleLevel; +v_scope(wholeSubtree) -> wholeSubtree; +v_scope(_Scope) -> throw({error,concat(["unknown scope: ",_Scope])}). + +v_bool(true) -> true; +v_bool(false) -> false; +v_bool(_Bool) -> throw({error,concat(["not Boolean: ",_Bool])}). + +v_timeout(I) when is_integer(I), I>=0 -> I; +v_timeout(_I) -> throw({error,concat(["timeout not positive integer: ",_I])}). + +v_attributes(Attrs) -> + F = fun(A) when is_list(A) -> A; + (A) -> throw({error,concat(["attribute not String: ",A])}) + end, + lists:map(F,Attrs). + + +%%% -------------------------------------------------------------------- +%%% Get and Validate the initial configuration +%%% -------------------------------------------------------------------- +get_config() -> + Priv_dir = code:priv_dir(eldap), + File = filename:join(Priv_dir, "eldap.conf"), + case file:consult(File) of + {ok, Entries} -> + case catch parse(Entries) of + {ok, Hosts, Port, Rootdn, Passwd, Log} -> + {ok, Hosts, Port, Rootdn, Passwd, Log}; + {error, Reason} -> + {error, Reason}; + {'EXIT', Reason} -> + {error, Reason} + end; + {error, Reason} -> + {error, Reason} + end. + +parse(Entries) -> + {ok, + get_hosts(host, Entries), + get_integer(port, Entries), + get_list(rootdn, Entries), + get_list(passwd, Entries), + get_log(log, Entries)}. + +get_integer(Key, List) -> + case lists:keysearch(Key, 1, List) of + {value, {Key, Value}} when is_integer(Value) -> + Value; + {value, {Key, _Value}} -> + throw({error, "Bad Value in Config for " ++ atom_to_list(Key)}); + false -> + throw({error, "No Entry in Config for " ++ atom_to_list(Key)}) + end. + +get_list(Key, List) -> + case lists:keysearch(Key, 1, List) of + {value, {Key, Value}} when is_list(Value) -> + Value; + {value, {Key, _Value}} -> + throw({error, "Bad Value in Config for " ++ atom_to_list(Key)}); + false -> + throw({error, "No Entry in Config for " ++ atom_to_list(Key)}) + end. + +get_log(Key, List) -> + case lists:keysearch(Key, 1, List) of + {value, {Key, Value}} when is_function(Value) -> + Value; + {value, {Key, _Else}} -> + false; + false -> + fun(_Level, Format, Args) -> io:format("--- " ++ Format, Args) end + end. + +get_hosts(Key, List) -> + lists:map(fun({Key1, {A,B,C,D}}) when is_integer(A), + is_integer(B), + is_integer(C), + is_integer(D), + Key == Key1-> + {A,B,C,D}; + ({Key1, Value}) when is_list(Value), + Key == Key1-> + Value; + ({_Else, _Value}) -> + throw({error, "Bad Hostname in config"}) + end, List). + +%%% -------------------------------------------------------------------- +%%% Other Stuff +%%% -------------------------------------------------------------------- +bump_id(#eldap{id = Id}) when Id > ?MAX_TRANSACTION_ID -> + ?MIN_TRANSACTION_ID; +bump_id(#eldap{id = Id}) -> + Id + 1. + +%%% -------------------------------------------------------------------- +%%% Log routines. Call a user provided log routine Fun. +%%% -------------------------------------------------------------------- + +log1(Str, Args, #eldap{log = Fun, debug_level = N}) -> log(Fun, Str, Args, 1, N). +log2(Str, Args, #eldap{log = Fun, debug_level = N}) -> log(Fun, Str, Args, 2, N). + +log(Fun, Str, Args, This_level, Status) when is_function(Fun), This_level =< Status -> + catch Fun(This_level, Str, Args); +log(_, _, _, _, _) -> + ok. diff --git a/lib/eldap/src/eldap_sup.erl b/lib/eldap/src/eldap_sup.erl new file mode 100644 index 0000000000..1a93bd15b7 --- /dev/null +++ b/lib/eldap/src/eldap_sup.erl @@ -0,0 +1,28 @@ + +-module(eldap_sup). + +-behaviour(supervisor). + +%% API +-export([start_link/0]). + +%% Supervisor callbacks +-export([init/1]). + +%% Helper macro for declaring children of supervisor +-define(CHILD(I, Type), {I, {I, start_link, []}, permanent, 5000, Type, [I]}). + +%% =================================================================== +%% API functions +%% =================================================================== + +start_link() -> + supervisor:start_link({local, ?MODULE}, ?MODULE, []). + +%% =================================================================== +%% Supervisor callbacks +%% =================================================================== + +init([]) -> + {ok, { {one_for_one, 5, 10}, []} }. + |