1-module(eldap). 2%%% -------------------------------------------------------------------- 3%%% Created: 12 Oct 2000 by Tobbe <tnt@home.se> 4%%% Function: Erlang client LDAP implementation according RFC 2251,2253 5%%% and 2255. The interface is based on RFC 1823, and 6%%% draft-ietf-asid-ldap-c-api-00.txt 7%%% 8%%% Copyright (c) 2010 Torbjorn Tornkvist 9%%% Copyright Ericsson AB 2011-2013. All Rights Reserved. 10%%% See MIT-LICENSE at the top dir for licensing information. 11%%% -------------------------------------------------------------------- 12-vc('$Id$ '). 13-export([open/1, open/2, 14 simple_bind/3, simple_bind/4, 15 controlling_process/2, 16 start_tls/2, start_tls/3, start_tls/4, 17 modify_password/3, modify_password/4, modify_password/5, 18 getopts/2, 19 baseObject/0,singleLevel/0,wholeSubtree/0,close/1, 20 equalityMatch/2,greaterOrEqual/2,lessOrEqual/2, 21 extensibleMatch/2, 22 search/2, search/3, 23 approxMatch/2,substrings/2,present/1, 24 'and'/1,'or'/1,'not'/1,mod_add/2, mod_delete/2, 25 mod_replace/2, 26 modify/3, modify/4, 27 add/3, add/4, 28 delete/2, delete/3, 29 modify_dn/5,parse_dn/1, 30 parse_ldap_url/1]). 31 32-export([neverDerefAliases/0, derefInSearching/0, 33 derefFindingBaseObj/0, derefAlways/0]). 34 35%% for upgrades 36-export([loop/2]). 37 38-import(lists,[concat/1]). 39 40-include("ELDAPv3.hrl"). 41-include("eldap.hrl"). 42 43-define(LDAP_VERSION, 3). 44-define(LDAP_PORT, 389). 45-define(LDAPS_PORT, 636). 46 47-record(eldap, {version = ?LDAP_VERSION, 48 host, % Host running LDAP server 49 port = ?LDAP_PORT, % The LDAP server port 50 fd, % Socket filedescriptor. 51 prev_fd, % Socket that was upgraded by start_tls 52 binddn = "", % Name of the entry to bind as 53 passwd, % Password for (above) entry 54 id = 0, % LDAP Request ID 55 log, % User provided log function 56 timeout = infinity, % Request timeout 57 anon_auth = false, % Allow anonymous authentication 58 ldaps = false, % LDAP/LDAPS 59 using_tls = false, % true if LDAPS or START_TLS executed 60 tls_opts = [], % ssl:ssloption() 61 tcp_opts = [] % inet6 support 62 }). 63 64%%% For debug purposes 65%%-define(PRINT(S, A), io:fwrite("~w(~w): " ++ S, [?MODULE,?LINE|A])). 66-define(PRINT(S, A), true). 67 68-define(elog(S, A), error_logger:info_msg("~w(~w): "++S,[?MODULE,?LINE|A])). 69 70%%% ==================================================================== 71%%% Exported interface 72%%% ==================================================================== 73 74%%% -------------------------------------------------------------------- 75%%% open(Hosts [,Opts] ) 76%%% -------------------- 77%%% Setup a connection to on of the Hosts in the argument 78%%% list. Stop at the first successful connection attempt. 79%%% Valid Opts are: Where: 80%%% 81%%% {port, Port} - Port is the port number 82%%% {log, F} - F(LogLevel, FormatString, ListOfArgs) 83%%% {timeout, milliSec} - Server request timeout 84%%% 85%%% -------------------------------------------------------------------- 86open(Hosts) -> 87 open(Hosts, []). 88 89open(Hosts, Opts) when is_list(Hosts), is_list(Opts) -> 90 Self = self(), 91 Pid = spawn_link(fun() -> init(Hosts, Opts, Self) end), 92 recv(Pid). 93 94%%% -------------------------------------------------------------------- 95%%% Upgrade an existing connection to tls 96%%% -------------------------------------------------------------------- 97start_tls(Handle, TlsOptions) -> 98 start_tls(Handle, TlsOptions, infinity). 99 100start_tls(Handle, TlsOptions, Timeout) -> 101 start_tls(Handle, TlsOptions, Timeout, asn1_NOVALUE). 102 103start_tls(Handle, TlsOptions, Timeout, Controls) -> 104 send(Handle, {start_tls,TlsOptions,Timeout,Controls}), 105 recv(Handle). 106 107%%% -------------------------------------------------------------------- 108%%% Modify the password of a user. 109%%% 110%%% Dn - Name of the entry to modify. If empty, the session user. 111%%% NewPasswd - New password. If empty, the server returns a new password. 112%%% OldPasswd - Original password for server verification, may be empty. 113%%% 114%%% Returns: ok | {ok, GenPasswd} | {error, term()} 115%%% -------------------------------------------------------------------- 116modify_password(Handle, Dn, NewPasswd) -> 117 modify_password(Handle, Dn, NewPasswd, []). 118 119modify_password(Handle, Dn, NewPasswd, OldPasswd) 120 when is_pid(Handle), is_list(Dn), is_list(NewPasswd), is_list(OldPasswd) -> 121 modify_password(Handle, Dn, NewPasswd, OldPasswd, asn1_NOVALUE). 122 123modify_password(Handle, Dn, NewPasswd, OldPasswd, Controls) 124 when is_pid(Handle), is_list(Dn), is_list(NewPasswd), is_list(OldPasswd) -> 125 send(Handle, {passwd_modify,optional(Dn),optional(NewPasswd),optional(OldPasswd),Controls}), 126 recv(Handle). 127 128%%% -------------------------------------------------------------------- 129%%% Ask for option values on the socket. 130%%% Warning: This is an undocumented function for testing purposes only. 131%%% Use at own risk... 132%%% -------------------------------------------------------------------- 133getopts(Handle, OptNames) when is_pid(Handle), is_list(OptNames) -> 134 send(Handle, {getopts, OptNames}), 135 recv(Handle). 136 137%%% -------------------------------------------------------------------- 138%%% Shutdown connection (and process) asynchronous. 139%%% -------------------------------------------------------------------- 140 141close(Handle) when is_pid(Handle) -> 142 send(Handle, close), 143 ok. 144 145%%% -------------------------------------------------------------------- 146%%% Set who we should link ourselves to 147%%% -------------------------------------------------------------------- 148 149controlling_process(Handle, Pid) when is_pid(Handle), is_pid(Pid) -> 150 link(Pid), 151 send(Handle, {cnt_proc, Pid}), 152 recv(Handle). 153 154%%% -------------------------------------------------------------------- 155%%% Authenticate ourselves to the Directory 156%%% using simple authentication. 157%%% 158%%% Dn - The name of the entry to bind as 159%%% Passwd - The password to be used 160%%% 161%%% Returns: ok | {error, Error} 162%%% -------------------------------------------------------------------- 163simple_bind(Handle, Dn, Passwd) when is_pid(Handle) -> 164 simple_bind(Handle, Dn, Passwd, asn1_NOVALUE). 165 166simple_bind(Handle, Dn, Passwd, Controls) when is_pid(Handle) -> 167 send(Handle, {simple_bind, Dn, Passwd, Controls}), 168 recv(Handle). 169 170%%% -------------------------------------------------------------------- 171%%% Add an entry. The entry field MUST NOT exist for the AddRequest 172%%% to succeed. The parent of the entry MUST exist. 173%%% Example: 174%%% 175%%% add(Handle, 176%%% "cn=Bill Valentine, ou=people, o=Bluetail AB, dc=bluetail, dc=com", 177%%% [{"objectclass", ["person"]}, 178%%% {"cn", ["Bill Valentine"]}, 179%%% {"sn", ["Valentine"]}, 180%%% {"telephoneNumber", ["545 555 00"]}] 181%%% ) 182%%% -------------------------------------------------------------------- 183add(Handle, Entry, Attributes) when is_pid(Handle),is_list(Entry),is_list(Attributes) -> 184 add(Handle, Entry, Attributes, asn1_NOVALUE). 185 186add(Handle, Entry, Attributes, Controls) when is_pid(Handle),is_list(Entry),is_list(Attributes) -> 187 send(Handle, {add, Entry, add_attrs(Attributes), Controls}), 188 recv(Handle). 189 190%%% Do sanity check ! 191add_attrs(Attrs) -> 192 F = fun({Type,Vals}) when is_list(Type),is_list(Vals) -> 193 %% Confused ? Me too... :-/ 194 {'AddRequest_attributes',Type, Vals} 195 end, 196 case catch lists:map(F, Attrs) of 197 {'EXIT', _} -> throw({error, attribute_values}); 198 Else -> Else 199 end. 200 201%%% -------------------------------------------------------------------- 202%%% Delete an entry. The entry consists of the DN of 203%%% the entry to be deleted. 204%%% Example: 205%%% 206%%% delete(Handle, 207%%% "cn=Bill Valentine, ou=people, o=Bluetail AB, dc=bluetail, dc=com" 208%%% ) 209%%% -------------------------------------------------------------------- 210delete(Handle, Entry) when is_pid(Handle), is_list(Entry) -> 211 delete(Handle, Entry, asn1_NOVALUE). 212 213delete(Handle, Entry, Controls) when is_pid(Handle), is_list(Entry) -> 214 send(Handle, {delete, Entry, Controls}), 215 recv(Handle). 216 217%%% -------------------------------------------------------------------- 218%%% Modify an entry. Given an entry a number of modification 219%%% operations can be performed as one atomic operation. 220%%% Example: 221%%% 222%%% modify(Handle, 223%%% "cn=Torbjorn Tornkvist, ou=people, o=Bluetail AB, dc=bluetail, dc=com", 224%%% [mod_replace("telephoneNumber", ["555 555 00"]), 225%%% mod_add("description", ["LDAP hacker"])] 226%%% ) 227%%% -------------------------------------------------------------------- 228modify(Handle, Object, Mods) when is_pid(Handle), is_list(Object), is_list(Mods) -> 229 modify(Handle, Object, Mods, asn1_NOVALUE). 230 231modify(Handle, Object, Mods, Controls) when is_pid(Handle), is_list(Object), is_list(Mods) -> 232 send(Handle, {modify, Object, Mods, Controls}), 233 recv(Handle). 234 235%%% 236%%% Modification operations. 237%%% Example: 238%%% mod_replace("telephoneNumber", ["555 555 00"]) 239%%% 240mod_add(Type, Values) when is_list(Type), is_list(Values) -> m(add, Type, Values). 241mod_delete(Type, Values) when is_list(Type), is_list(Values) -> m(delete, Type, Values). 242mod_replace(Type, Values) when is_list(Type), is_list(Values) -> m(replace, Type, Values). 243 244m(Operation, Type, Values) -> 245 #'ModifyRequest_changes_SEQOF'{ 246 operation = Operation, 247 modification = #'PartialAttribute'{ 248 type = Type, 249 vals = Values}}. 250 251%%% -------------------------------------------------------------------- 252%%% Modify an entry. Given an entry a number of modification 253%%% operations can be performed as one atomic operation. 254%%% Example: 255%%% 256%%% modify_dn(Handle, 257%%% "cn=Bill Valentine, ou=people, o=Bluetail AB, dc=bluetail, dc=com", 258%%% "cn=Ben Emerson", 259%%% true, 260%%% "" 261%%% ) 262%%% -------------------------------------------------------------------- 263modify_dn(Handle, Entry, NewRDN, DelOldRDN, NewSup) 264 when is_pid(Handle),is_list(Entry),is_list(NewRDN),is_atom(DelOldRDN),is_list(NewSup) -> 265 modify_dn(Handle, Entry, NewRDN, DelOldRDN, NewSup, asn1_NOVALUE). 266 267modify_dn(Handle, Entry, NewRDN, DelOldRDN, NewSup, Controls) 268 when is_pid(Handle),is_list(Entry),is_list(NewRDN),is_atom(DelOldRDN),is_list(NewSup) -> 269 send(Handle, {modify_dn, Entry, NewRDN, 270 bool_p(DelOldRDN), optional(NewSup), Controls}), 271 recv(Handle). 272 273%%% Sanity checks ! 274 275bool_p(Bool) when is_boolean(Bool) -> Bool. 276 277optional([]) -> asn1_NOVALUE; 278optional(Value) -> Value. 279 280%%% -------------------------------------------------------------------- 281%%% Synchronous search of the Directory returning a 282%%% requested set of attributes. 283%%% 284%%% Example: 285%%% 286%%% Filter = eldap:substrings("cn", [{any,"o"}]), 287%%% eldap:search(S, [{base, "dc=bluetail, dc=com"}, 288%%% {filter, Filter}, 289%%% {attributes,["cn"]}])), 290%%% 291%%% Returned result: {ok, #eldap_search_result{}} 292%%% 293%%% Example: 294%%% 295%%% {ok,{eldap_search_result, 296%%% [{eldap_entry, 297%%% "cn=Magnus Froberg, dc=bluetail, dc=com", 298%%% [{"cn",["Magnus Froberg"]}]}, 299%%% {eldap_entry, 300%%% "cn=Torbjorn Tornkvist, dc=bluetail, dc=com", 301%%% [{"cn",["Torbjorn Tornkvist"]}]}], 302%%% []}} 303%%% 304%%% -------------------------------------------------------------------- 305search(Handle, X) when is_pid(Handle), is_record(X,eldap_search) ; is_list(X) -> 306 search(Handle, X, asn1_NOVALUE). 307 308search(Handle, A, Controls) when is_pid(Handle), is_record(A, eldap_search) -> 309 call_search(Handle, A, Controls); 310search(Handle, L, Controls) when is_pid(Handle), is_list(L) -> 311 case catch parse_search_args(L) of 312 {error, Emsg} -> {error, Emsg}; 313 A when is_record(A, eldap_search) -> call_search(Handle, A, Controls) 314 end. 315 316call_search(Handle, A, Controls) -> 317 send(Handle, {search, A, Controls}), 318 recv(Handle). 319 320parse_search_args(Args) -> 321 parse_search_args(Args, 322 #eldap_search{scope = wholeSubtree, 323 deref = derefAlways}). 324 325parse_search_args([{base, Base}|T],A) -> 326 parse_search_args(T,A#eldap_search{base = Base}); 327parse_search_args([{filter, Filter}|T],A) -> 328 parse_search_args(T,A#eldap_search{filter = Filter}); 329parse_search_args([{size_limit, SizeLimit}|T],A) when is_integer(SizeLimit) -> 330 parse_search_args(T,A#eldap_search{size_limit = SizeLimit}); 331parse_search_args([{scope, Scope}|T],A) -> 332 parse_search_args(T,A#eldap_search{scope = Scope}); 333parse_search_args([{deref, Deref}|T],A) -> 334 parse_search_args(T,A#eldap_search{deref = Deref}); 335parse_search_args([{attributes, Attrs}|T],A) -> 336 parse_search_args(T,A#eldap_search{attributes = Attrs}); 337parse_search_args([{types_only, TypesOnly}|T],A) -> 338 parse_search_args(T,A#eldap_search{types_only = TypesOnly}); 339parse_search_args([{timeout, Timeout}|T],A) when is_integer(Timeout) -> 340 parse_search_args(T,A#eldap_search{timeout = Timeout}); 341parse_search_args([H|_],_) -> 342 throw({error,{unknown_arg, H}}); 343parse_search_args([],A) -> 344 A. 345 346%%% 347%%% The Scope parameter 348%%% 349baseObject() -> baseObject. 350singleLevel() -> singleLevel. 351wholeSubtree() -> wholeSubtree. 352 353%% 354%% The derefAliases parameter 355%% 356neverDerefAliases() -> neverDerefAliases. 357derefInSearching() -> derefInSearching. 358derefFindingBaseObj() -> derefFindingBaseObj. 359derefAlways() -> derefAlways. 360 361%%% 362%%% Boolean filter operations 363%%% 364'and'(ListOfFilters) when is_list(ListOfFilters) -> {'and',ListOfFilters}. 365'or'(ListOfFilters) when is_list(ListOfFilters) -> {'or', ListOfFilters}. 366'not'(Filter) when is_tuple(Filter) -> {'not',Filter}. 367 368%%% 369%%% The following Filter parameters consist of an attribute 370%%% and an attribute value. Example: F("uid","tobbe") 371%%% 372equalityMatch(Desc, Value) -> {equalityMatch, av_assert(Desc, Value)}. 373greaterOrEqual(Desc, Value) -> {greaterOrEqual, av_assert(Desc, Value)}. 374lessOrEqual(Desc, Value) -> {lessOrEqual, av_assert(Desc, Value)}. 375approxMatch(Desc, Value) -> {approxMatch, av_assert(Desc, Value)}. 376 377av_assert(Desc, Value) -> 378 #'AttributeValueAssertion'{attributeDesc = Desc, 379 assertionValue = Value}. 380 381%%% 382%%% Filter to check for the presence of an attribute 383%%% 384present(Attribute) when is_list(Attribute) -> 385 {present, Attribute}. 386 387 388%%% 389%%% A substring filter seem to be based on a pattern: 390%%% 391%%% InitValue*AnyValue*FinalValue 392%%% 393%%% where all three parts seem to be optional (at least when 394%%% talking with an OpenLDAP server). Thus, the arguments 395%%% to substrings/2 looks like this: 396%%% 397%%% Type ::= string( <attribute> ) 398%%% SubStr ::= listof( {initial,Value} | {any,Value}, {final,Value}) 399%%% 400%%% Example: substrings("sn",[{initial,"To"},{any,"kv"},{final,"st"}]) 401%%% will match entries containing: 'sn: Tornkvist' 402%%% 403substrings(Type, SubStr) when is_list(Type), is_list(SubStr) -> 404 Ss = v_substr(SubStr), 405 {substrings,#'SubstringFilter'{type = Type, 406 substrings = Ss}}. 407 408%%% 409%%% Filter for extensibleMatch 410%%% 411extensibleMatch(MatchValue, OptArgs) -> 412 MatchingRuleAssertion = 413 mra(OptArgs, #'MatchingRuleAssertion'{matchValue = MatchValue}), 414 {extensibleMatch, MatchingRuleAssertion}. 415 416mra([{matchingRule,Val}|T], Ack) when is_list(Val) -> 417 mra(T, Ack#'MatchingRuleAssertion'{matchingRule=Val}); 418mra([{type,Val}|T], Ack) when is_list(Val) -> 419 mra(T, Ack#'MatchingRuleAssertion'{type=Val}); 420mra([{dnAttributes,true}|T], Ack) -> 421 mra(T, Ack#'MatchingRuleAssertion'{dnAttributes="TRUE"}); 422mra([{dnAttributes,false}|T], Ack) -> 423 mra(T, Ack#'MatchingRuleAssertion'{dnAttributes="FALSE"}); 424mra([H|_], _) -> 425 throw({error,{extensibleMatch_arg,H}}); 426mra([], Ack) -> 427 Ack. 428 429%%% -------------------------------------------------------------------- 430%%% Worker process. We keep track of a controlling process to 431%%% be able to terminate together with it. 432%%% -------------------------------------------------------------------- 433 434init(Hosts, Opts, Cpid) -> 435 Data = parse_args(Opts, Cpid, #eldap{}), 436 case try_connect(Hosts, Data) of 437 {ok,Data2} -> 438 send(Cpid, {ok,self()}), 439 ?MODULE:loop(Cpid, Data2); 440 Else -> 441 send(Cpid, Else), 442 unlink(Cpid), 443 exit(Else) 444 end. 445 446parse_args([{port, Port}|T], Cpid, Data) when is_integer(Port) -> 447 parse_args(T, Cpid, Data#eldap{port = Port}); 448parse_args([{timeout, Timeout}|T], Cpid, Data) when is_integer(Timeout),Timeout>0 -> 449 parse_args(T, Cpid, Data#eldap{timeout = Timeout}); 450parse_args([{anon_auth, true}|T], Cpid, Data) -> 451 parse_args(T, Cpid, Data#eldap{anon_auth = true}); 452parse_args([{anon_auth, _}|T], Cpid, Data) -> 453 parse_args(T, Cpid, Data); 454parse_args([{ssl, true}|T], Cpid, Data) -> 455 parse_args(T, Cpid, Data#eldap{ldaps = true, using_tls=true}); 456parse_args([{ssl, _}|T], Cpid, Data) -> 457 parse_args(T, Cpid, Data); 458parse_args([{sslopts, Opts}|T], Cpid, Data) when is_list(Opts) -> 459 parse_args(T, Cpid, Data#eldap{ldaps = true, using_tls=true, tls_opts = Opts ++ Data#eldap.tls_opts}); 460parse_args([{sslopts, _}|T], Cpid, Data) -> 461 parse_args(T, Cpid, Data); 462parse_args([{tcpopts, Opts}|T], Cpid, Data) when is_list(Opts) -> 463 parse_args(T, Cpid, Data#eldap{tcp_opts = tcp_opts(Opts,Cpid,Data#eldap.tcp_opts)}); 464parse_args([{log, F}|T], Cpid, Data) when is_function(F) -> 465 parse_args(T, Cpid, Data#eldap{log = F}); 466parse_args([{log, _}|T], Cpid, Data) -> 467 parse_args(T, Cpid, Data); 468parse_args([H|_], Cpid, _) -> 469 send(Cpid, {error,{wrong_option,H}}), 470 unlink(Cpid), 471 exit(wrong_option); 472parse_args([], _, Data) -> 473 Data. 474 475tcp_opts([Opt|Opts], Cpid, Acc) -> 476 Key = if is_atom(Opt) -> Opt; 477 is_tuple(Opt) -> element(1,Opt) 478 end, 479 case lists:member(Key,[active,binary,deliver,list,mode,packet]) of 480 false -> 481 tcp_opts(Opts, Cpid, [Opt|Acc]); 482 true -> 483 tcp_opts_error(Opt, Cpid) 484 end; 485tcp_opts([], _Cpid, Acc) -> Acc. 486 487tcp_opts_error(Opt, Cpid) -> 488 send(Cpid, {error, {{forbidden_tcp_option,Opt}, 489 "This option affects the eldap functionality and can't be set by user"}}), 490 unlink(Cpid), 491 exit(forbidden_tcp_option). 492 493%%% Try to connect to the hosts in the listed order, 494%%% and stop with the first one to which a successful 495%%% connection is made. 496 497try_connect([Host|Hosts], Data) -> 498 TcpOpts = [{packet, asn1}, {active,false}], 499 try do_connect(Host, Data, TcpOpts) of 500 {ok,Fd} -> {ok,Data#eldap{host = Host, fd = Fd}}; 501 Err -> 502 log2(Data, "Connect: ~p failed ~p~n",[Host, Err]), 503 try_connect(Hosts, Data) 504 catch _:Err -> 505 log2(Data, "Connect: ~p failed ~p~n",[Host, Err]), 506 try_connect(Hosts, Data) 507 end; 508try_connect([],_) -> 509 {error,"connect failed"}. 510 511do_connect(Host, Data, Opts) when Data#eldap.ldaps == false -> 512 gen_tcp:connect(Host, Data#eldap.port, Opts ++ Data#eldap.tcp_opts, 513 Data#eldap.timeout); 514do_connect(Host, Data, Opts) when Data#eldap.ldaps == true -> 515 ssl:connect(Host, Data#eldap.port, 516 Opts ++ Data#eldap.tls_opts ++ Data#eldap.tcp_opts, 517 Data#eldap.timeout). 518 519loop(Cpid, Data) -> 520 receive 521 522 {From, {search, A, Controls}} -> 523 {Res,NewData} = do_search(Data, A, Controls), 524 send(From,Res), 525 ?MODULE:loop(Cpid, NewData); 526 527 {From, {modify, Obj, Mod, Controls}} -> 528 {Res,NewData} = do_modify(Data, Obj, Mod, Controls), 529 send(From,Res), 530 ?MODULE:loop(Cpid, NewData); 531 532 {From, {modify_dn, Obj, NewRDN, DelOldRDN, NewSup, Controls}} -> 533 {Res,NewData} = do_modify_dn(Data, Obj, NewRDN, DelOldRDN, NewSup, Controls), 534 send(From,Res), 535 ?MODULE:loop(Cpid, NewData); 536 537 {From, {add, Entry, Attrs, Controls}} -> 538 {Res,NewData} = do_add(Data, Entry, Attrs, Controls), 539 send(From,Res), 540 ?MODULE:loop(Cpid, NewData); 541 542 {From, {delete, Entry, Controls}} -> 543 {Res,NewData} = do_delete(Data, Entry, Controls), 544 send(From,Res), 545 ?MODULE:loop(Cpid, NewData); 546 547 {From, {simple_bind, Dn, Passwd, Controls}} -> 548 {Res,NewData} = do_simple_bind(Data, Dn, Passwd, Controls), 549 send(From,Res), 550 ?MODULE:loop(Cpid, NewData); 551 552 {From, {cnt_proc, NewCpid}} -> 553 unlink(Cpid), 554 send(From,ok), 555 ?PRINT("New Cpid is: ~p~n",[NewCpid]), 556 ?MODULE:loop(NewCpid, Data); 557 558 {From, {start_tls,TlsOptions,Timeout,Controls}} -> 559 {Res,NewData} = do_start_tls(Data, TlsOptions, Timeout, Controls), 560 send(From,Res), 561 ?MODULE:loop(Cpid, NewData); 562 563 {From, {passwd_modify,Dn,NewPasswd,OldPasswd,Controls}} -> 564 {Res,NewData} = do_passwd_modify(Data, Dn, NewPasswd, OldPasswd, Controls), 565 send(From, Res), 566 ?MODULE:loop(Cpid, NewData); 567 568 {_From, close} -> 569 % Ignore tcp error if connection is already closed. 570 try do_unbind(Data) of 571 {no_reply,_NewData} -> ok 572 catch 573 throw:{gen_tcp_error, _TcpErr} -> ok 574 end, 575 unlink(Cpid), 576 exit(closed); 577 578 {From, {getopts, OptNames}} -> 579 Result = 580 try 581 [case OptName of 582 port -> {port, Data#eldap.port}; 583 log -> {log, Data#eldap.log}; 584 timeout -> {timeout, Data#eldap.timeout}; 585 ssl -> {ssl, Data#eldap.ldaps}; 586 {sslopts, SslOptNames} when Data#eldap.using_tls==true -> 587 case ssl:getopts(Data#eldap.fd, SslOptNames) of 588 {ok,SslOptVals} -> {sslopts, SslOptVals}; 589 {error,Reason} -> throw({error,Reason}) 590 end; 591 {sslopts, _} -> 592 throw({error,no_tls}); 593 {tcpopts, TcpOptNames} -> 594 case inet:getopts(Data#eldap.fd, TcpOptNames) of 595 {ok,TcpOptVals} -> {tcpopts, TcpOptVals}; 596 {error,Posix} -> throw({error,Posix}) 597 end 598 end || OptName <- OptNames] 599 of 600 OptsList -> {ok,OptsList} 601 catch 602 throw:Error -> Error; 603 Class:Error -> {error,{Class,Error}} 604 end, 605 send(From, Result), 606 ?MODULE:loop(Cpid, Data); 607 608 {Cpid, 'EXIT', Reason} -> 609 ?PRINT("Got EXIT from Cpid, reason=~p~n",[Reason]), 610 exit(Reason); 611 612 _XX -> 613 ?PRINT("loop got: ~p~n",[_XX]), 614 ?MODULE:loop(Cpid, Data) 615 616 end. 617 618 619%%% -------------------------------------------------------------------- 620%%% startTLS Request 621%%% -------------------------------------------------------------------- 622do_start_tls(Data=#eldap{using_tls=true}, _, _, _) -> 623 {{error,tls_already_started}, Data}; 624do_start_tls(Data=#eldap{fd=FD} , TlsOptions, Timeout, Controls) -> 625 case catch exec_start_tls(Data, Controls) of 626 {ok,NewData} -> 627 case ssl:connect(FD,TlsOptions,Timeout) of 628 {ok, SslSocket} -> 629 {ok, NewData#eldap{prev_fd = FD, 630 fd = SslSocket, 631 using_tls = true 632 }}; 633 {error,Error} -> 634 {{error,Error}, Data} 635 end; 636 {{ok,Val},NewData} -> {{ok,Val},NewData}; 637 {error,Error} -> {{error,Error},Data}; 638 Else -> {{error,Else},Data} 639 end. 640 641-define(START_TLS_OID, "1.3.6.1.4.1.1466.20037"). 642 643exec_start_tls(Data, Controls) -> 644 Req = #'ExtendedRequest'{requestName = ?START_TLS_OID}, 645 Reply = request(Data#eldap.fd, Data, Data#eldap.id, {extendedReq, Req, Controls}), 646 exec_extended_req_reply(Data, Reply). 647 648exec_extended_req_reply(Data, {ok,Msg}) when 649 Msg#'LDAPMessage'.messageID == Data#eldap.id -> 650 case Msg#'LDAPMessage'.protocolOp of 651 {extendedResp, Result} -> 652 case Result#'ExtendedResponse'.resultCode of 653 success -> 654 {ok,Data}; 655 referral -> 656 {{ok, {referral,Result#'ExtendedResponse'.referral}}, Data}; 657 Error -> 658 {error, {response,Error}} 659 end; 660 Other -> {error, Other} 661 end; 662exec_extended_req_reply(_, Error) -> 663 {error, Error}. 664 665%%% -------------------------------------------------------------------- 666%%% bindRequest 667%%% -------------------------------------------------------------------- 668 669%%% Authenticate ourselves to the directory using 670%%% simple authentication. 671 672do_simple_bind(Data, anon, anon, Controls) -> %% For testing 673 do_the_simple_bind(Data, "", "", Controls); 674do_simple_bind(Data, Dn, _Passwd,_) when Dn=="",Data#eldap.anon_auth==false -> 675 {{error,anonymous_auth},Data}; 676do_simple_bind(Data, _Dn, Passwd,_) when Passwd=="",Data#eldap.anon_auth==false -> 677 {{error,anonymous_auth},Data}; 678do_simple_bind(Data, Dn, Passwd, Controls) -> 679 do_the_simple_bind(Data, Dn, Passwd, Controls). 680 681do_the_simple_bind(Data, Dn, Passwd, Controls) -> 682 case catch exec_simple_bind(Data#eldap{binddn = Dn, 683 passwd = Passwd, 684 id = bump_id(Data)}, 685 Controls) of 686 {ok,NewData} -> {ok,NewData}; 687 {{ok,Val},NewData} -> {{ok,Val},NewData}; 688 {error,Emsg} -> {{error,Emsg},Data}; 689 Else -> {{error,Else},Data} 690 end. 691 692exec_simple_bind(Data, Controls) -> 693 Req = #'BindRequest'{version = Data#eldap.version, 694 name = Data#eldap.binddn, 695 authentication = {simple, Data#eldap.passwd}}, 696 log2(Data, "bind request = ~p~n", [Req]), 697 Reply = request(Data#eldap.fd, Data, Data#eldap.id, {bindRequest, Req, Controls}), 698 log2(Data, "bind reply = ~p~n", [Reply]), 699 exec_simple_bind_reply(Data, Reply). 700 701exec_simple_bind_reply(Data, {ok,Msg}) when 702 Msg#'LDAPMessage'.messageID == Data#eldap.id -> 703 case Msg#'LDAPMessage'.protocolOp of 704 {bindResponse, Result} -> 705 case Result#'BindResponse'.resultCode of 706 success -> {ok,Data}; 707 referral -> {{ok, {referral,Result#'BindResponse'.referral}}, Data}; 708 Error -> {error, Error} 709 end; 710 Other -> {error, Other} 711 end; 712exec_simple_bind_reply(_, Error) -> 713 {error, Error}. 714 715 716%%% -------------------------------------------------------------------- 717%%% searchRequest 718%%% -------------------------------------------------------------------- 719 720do_search(Data, A, Controls) -> 721 case catch do_search_0(Data, A, Controls) of 722 {error,Emsg} -> {ldap_closed_p(Data, Emsg),Data}; 723 {'EXIT',Error} -> {ldap_closed_p(Data, Error),Data}; 724 {{ok,Val},NewData} -> {{ok,Val},NewData}; 725 {ok,Res,Ref,NewData} -> {{ok,polish(Res, Ref)},NewData}; 726 {{error,Reason},NewData} -> {{error,Reason},NewData}; 727 Else -> {ldap_closed_p(Data, Else),Data} 728 end. 729 730%%% 731%%% Polish the returned search result 732%%% 733 734polish(Res, Ref) -> 735 R = polish_result(Res), 736 %%% No special treatment of referrals at the moment. 737 #eldap_search_result{entries = R, 738 referrals = Ref}. 739 740polish_result([H|T]) when is_record(H, 'SearchResultEntry') -> 741 ObjectName = H#'SearchResultEntry'.objectName, 742 F = fun({_,A,V}) -> {A,V} end, 743 Attrs = lists:map(F, H#'SearchResultEntry'.attributes), 744 [#eldap_entry{object_name = ObjectName, 745 attributes = Attrs}| 746 polish_result(T)]; 747polish_result([]) -> 748 []. 749 750do_search_0(Data, A, Controls) -> 751 Req = #'SearchRequest'{baseObject = A#eldap_search.base, 752 scope = v_scope(A#eldap_search.scope), 753 derefAliases = v_deref(A#eldap_search.deref), 754 sizeLimit = v_size_limit(A#eldap_search.size_limit), 755 timeLimit = v_timeout(A#eldap_search.timeout), 756 typesOnly = v_bool(A#eldap_search.types_only), 757 filter = v_filter(A#eldap_search.filter), 758 attributes = v_attributes(A#eldap_search.attributes) 759 }, 760 Id = bump_id(Data), 761 collect_search_responses(Data#eldap{id=Id}, Req, Id, Controls). 762 763%%% The returned answers cames in one packet per entry 764%%% mixed with possible referals 765 766collect_search_responses(Data, Req, ID, Controls) -> 767 S = Data#eldap.fd, 768 log2(Data, "search request = ~p~n", [Req]), 769 send_request(S, Data, ID, {searchRequest, Req, Controls}), 770 Resp = recv_response(S, Data), 771 log2(Data, "search reply = ~p~n", [Resp]), 772 collect_search_responses(Data, S, ID, Resp, [], []). 773 774collect_search_responses(Data, S, ID, {ok,Msg}, Acc, Ref) 775 when is_record(Msg,'LDAPMessage') -> 776 case Msg#'LDAPMessage'.protocolOp of 777 {'searchResDone',R} -> 778 case R#'LDAPResult'.resultCode of 779 success -> 780 log2(Data, "search reply = searchResDone ~n", []), 781 {ok,Acc,Ref,Data}; 782 sizeLimitExceeded -> 783 log2(Data, "[TRUNCATED] search reply = searchResDone ~n", []), 784 {ok,Acc,Ref,Data}; 785 referral -> 786 {{ok, {referral,R#'LDAPResult'.referral}}, Data}; 787 Reason -> 788 {{error,Reason},Data} 789 end; 790 {'searchResEntry',R} when is_record(R,'SearchResultEntry') -> 791 Resp = recv_response(S, Data), 792 log2(Data, "search reply = ~p~n", [Resp]), 793 collect_search_responses(Data, S, ID, Resp, [R|Acc], Ref); 794 {'searchResRef',R} -> 795 %% At the moment we don't do anyting sensible here since 796 %% I haven't been able to trigger the server to generate 797 %% a response like this. 798 Resp = recv_response(S, Data), 799 log2(Data, "search reply = ~p~n", [Resp]), 800 collect_search_responses(Data, S, ID, Resp, Acc, [R|Ref]); 801 Else -> 802 throw({error,Else}) 803 end; 804collect_search_responses(_, _, _, Else, _, _) -> 805 throw({error,Else}). 806 807%%% -------------------------------------------------------------------- 808%%% addRequest 809%%% -------------------------------------------------------------------- 810 811do_add(Data, Entry, Attrs, Controls) -> 812 case catch do_add_0(Data, Entry, Attrs, Controls) of 813 {error,Emsg} -> {ldap_closed_p(Data, Emsg),Data}; 814 {'EXIT',Error} -> {ldap_closed_p(Data, Error),Data}; 815 {ok,NewData} -> {ok,NewData}; 816 {{ok,Val},NewData} -> {{ok,Val},NewData}; 817 Else -> {ldap_closed_p(Data, Else),Data} 818 end. 819 820do_add_0(Data, Entry, Attrs, Controls) -> 821 Req = #'AddRequest'{entry = Entry, 822 attributes = Attrs}, 823 S = Data#eldap.fd, 824 Id = bump_id(Data), 825 log2(Data, "add request = ~p~n", [Req]), 826 Resp = request(S, Data, Id, {addRequest, Req, Controls}), 827 log2(Data, "add reply = ~p~n", [Resp]), 828 check_reply(Data#eldap{id = Id}, Resp, addResponse). 829 830 831%%% -------------------------------------------------------------------- 832%%% deleteRequest 833%%% -------------------------------------------------------------------- 834 835do_delete(Data, Entry, Controls) -> 836 case catch do_delete_0(Data, Entry, Controls) of 837 {error,Emsg} -> {ldap_closed_p(Data, Emsg),Data}; 838 {'EXIT',Error} -> {ldap_closed_p(Data, Error),Data}; 839 {ok,NewData} -> {ok,NewData}; 840 {{ok,Val},NewData} -> {{ok,Val},NewData}; 841 Else -> {ldap_closed_p(Data, Else),Data} 842 end. 843 844do_delete_0(Data, Entry, Controls) -> 845 S = Data#eldap.fd, 846 Id = bump_id(Data), 847 log2(Data, "del request = ~p~n", [Entry]), 848 Resp = request(S, Data, Id, {delRequest, Entry, Controls}), 849 log2(Data, "del reply = ~p~n", [Resp]), 850 check_reply(Data#eldap{id = Id}, Resp, delResponse). 851 852 853%%% -------------------------------------------------------------------- 854%%% modifyRequest 855%%% -------------------------------------------------------------------- 856 857do_modify(Data, Obj, Mod, Controls) -> 858 case catch do_modify_0(Data, Obj, Mod, Controls) of 859 {error,Emsg} -> {ldap_closed_p(Data, Emsg),Data}; 860 {'EXIT',Error} -> {ldap_closed_p(Data, Error),Data}; 861 {ok,NewData} -> {ok,NewData}; 862 {{ok,Val},NewData} -> {{ok,Val},NewData}; 863 Else -> {ldap_closed_p(Data, Else),Data} 864 end. 865 866do_modify_0(Data, Obj, Mod, Controls) -> 867 v_modifications(Mod), 868 Req = #'ModifyRequest'{object = Obj, 869 changes = Mod}, 870 S = Data#eldap.fd, 871 Id = bump_id(Data), 872 log2(Data, "modify request = ~p~n", [Req]), 873 Resp = request(S, Data, Id, {modifyRequest, Req, Controls}), 874 log2(Data, "modify reply = ~p~n", [Resp]), 875 check_reply(Data#eldap{id = Id}, Resp, modifyResponse). 876 877%%% -------------------------------------------------------------------- 878%%% PasswdModifyRequest 879%%% -------------------------------------------------------------------- 880 881-define(PASSWD_MODIFY_OID, "1.3.6.1.4.1.4203.1.11.1"). 882 883do_passwd_modify(Data, Dn, NewPasswd, OldPasswd, Controls) -> 884 case catch do_passwd_modify_0(Data, Dn, NewPasswd, OldPasswd, Controls) of 885 {error,Emsg} -> {ldap_closed_p(Data, Emsg),Data}; 886 {'EXIT',Error} -> {ldap_closed_p(Data, Error),Data}; 887 {ok,NewData} -> {ok,NewData}; 888 {{ok,Val},NewData} -> {{ok,Val},NewData}; 889 {ok,Passwd,NewData} -> {{ok, Passwd},NewData}; 890 Else -> {ldap_closed_p(Data, Else),Data} 891 end. 892 893do_passwd_modify_0(Data, Dn, NewPasswd, OldPasswd, Controls) -> 894 Req = #'PasswdModifyRequestValue'{userIdentity = Dn, 895 oldPasswd = OldPasswd, 896 newPasswd = NewPasswd}, 897 log2(Data, "modify password request = ~p~n", [Req]), 898 {ok, Bytes} = 'ELDAPv3':encode('PasswdModifyRequestValue', Req), 899 ExtReq = #'ExtendedRequest'{requestName = ?PASSWD_MODIFY_OID, 900 requestValue = Bytes}, 901 Id = bump_id(Data), 902 log2(Data, "extended request = ~p~n", [ExtReq]), 903 Reply = request(Data#eldap.fd, Data, Id, {extendedReq, ExtReq, Controls}), 904 log2(Data, "modify password reply = ~p~n", [Reply]), 905 exec_passwd_modify_reply(Data#eldap{id = Id}, Reply). 906 907exec_passwd_modify_reply(Data, {ok,Msg}) when 908 Msg#'LDAPMessage'.messageID == Data#eldap.id -> 909 case Msg#'LDAPMessage'.protocolOp of 910 {extendedResp, Result} -> 911 case Result#'ExtendedResponse'.resultCode of 912 success -> 913 case Result#'ExtendedResponse'.responseValue of 914 asn1_NOVALUE -> 915 {ok, Data}; 916 Value -> 917 case 'ELDAPv3':decode('PasswdModifyResponseValue', Value) of 918 {ok,#'PasswdModifyResponseValue'{genPasswd = Passwd}} -> 919 {ok, Passwd, Data}; 920 Error -> 921 throw(Error) 922 end 923 end; 924 referral -> 925 {{ok, {referral,Result#'ExtendedResponse'.referral}}, Data}; 926 Error -> 927 {error, {response,Error}} 928 end; 929 Other -> {error, Other} 930 end; 931exec_passwd_modify_reply(_, Error) -> 932 {error, Error}. 933 934%%% -------------------------------------------------------------------- 935%%% modifyDNRequest 936%%% -------------------------------------------------------------------- 937 938do_modify_dn(Data, Entry, NewRDN, DelOldRDN, NewSup, Controls) -> 939 case catch do_modify_dn_0(Data, Entry, NewRDN, DelOldRDN, NewSup, Controls) of 940 {error,Emsg} -> {ldap_closed_p(Data, Emsg),Data}; 941 {'EXIT',Error} -> {ldap_closed_p(Data, Error),Data}; 942 {ok,NewData} -> {ok,NewData}; 943 {{ok,Val},NewData} -> {{ok,Val},NewData}; 944 Else -> {ldap_closed_p(Data, Else),Data} 945 end. 946 947do_modify_dn_0(Data, Entry, NewRDN, DelOldRDN, NewSup, Controls) -> 948 Req = #'ModifyDNRequest'{entry = Entry, 949 newrdn = NewRDN, 950 deleteoldrdn = DelOldRDN, 951 newSuperior = NewSup}, 952 S = Data#eldap.fd, 953 Id = bump_id(Data), 954 log2(Data, "modify DN request = ~p~n", [Req]), 955 Resp = request(S, Data, Id, {modDNRequest, Req, Controls}), 956 log2(Data, "modify DN reply = ~p~n", [Resp]), 957 check_reply(Data#eldap{id = Id}, Resp, modDNResponse). 958 959%%%-------------------------------------------------------------------- 960%%% unbindRequest 961%%%-------------------------------------------------------------------- 962do_unbind(Data) -> 963 Req = "", 964 log2(Data, "unbind request = ~p (has no reply)~n", [Req]), 965 _ = case Data#eldap.using_tls of 966 true -> 967 send_request(Data#eldap.fd, Data, Data#eldap.id, {unbindRequest, Req}), 968 ssl:close(Data#eldap.fd); 969 false -> 970 OldTrapExit = process_flag(trap_exit, true), 971 catch send_request(Data#eldap.fd, Data, Data#eldap.id, {unbindRequest, Req}), 972 catch gen_tcp:close(Data#eldap.fd), 973 receive 974 {'EXIT', _From, _Reason} -> ok 975 after 0 -> ok 976 end, 977 process_flag(trap_exit, OldTrapExit) 978 end, 979 {no_reply, Data#eldap{binddn = (#eldap{})#eldap.binddn, 980 passwd = (#eldap{})#eldap.passwd, 981 fd = (#eldap{})#eldap.fd, 982 using_tls = false 983 }}. 984 985 986%%% -------------------------------------------------------------------- 987%%% Send an LDAP request and receive the answer 988%%% -------------------------------------------------------------------- 989request(S, Data, ID, Request) -> 990 send_request(S, Data, ID, Request), 991 recv_response(S, Data). 992 993send_request(S, Data, Id, {T,P}) -> 994 send_the_LDAPMessage(S, Data, #'LDAPMessage'{messageID = Id, 995 protocolOp = {T,P}}); 996send_request(S, Data, Id, {T,P,asn1_NOVALUE}) -> 997 send_the_LDAPMessage(S, Data, #'LDAPMessage'{messageID = Id, 998 protocolOp = {T,P}}); 999send_request(S, Data, Id, {T,P,Controls0}) -> 1000 Controls = [#'Control'{controlType=F1, 1001 criticality=F2, 1002 controlValue=F3} || {control,F1,F2,F3} <- Controls0], 1003 send_the_LDAPMessage(S, Data, #'LDAPMessage'{messageID = Id, 1004 protocolOp = {T,P}, 1005 controls = Controls}). 1006 1007send_the_LDAPMessage(S, Data, LDAPMessage) -> 1008 {ok,Bytes} = 'ELDAPv3':encode('LDAPMessage', LDAPMessage), 1009 case do_send(S, Data, Bytes) of 1010 {error,Reason} -> throw({gen_tcp_error,Reason}); 1011 Else -> Else 1012 end. 1013 1014do_send(S, Data, Bytes) when Data#eldap.using_tls == false -> 1015 gen_tcp:send(S, Bytes); 1016do_send(S, Data, Bytes) when Data#eldap.using_tls == true -> 1017 ssl:send(S, Bytes). 1018 1019do_recv(S, #eldap{using_tls=false, timeout=Timeout}, Len) -> 1020 gen_tcp:recv(S, Len, Timeout); 1021do_recv(S, #eldap{using_tls=true, timeout=Timeout}, Len) -> 1022 ssl:recv(S, Len, Timeout). 1023 1024recv_response(S, Data) -> 1025 case do_recv(S, Data, 0) of 1026 {ok, Packet} -> 1027 case 'ELDAPv3':decode('LDAPMessage', Packet) of 1028 {ok,Resp} -> {ok,Resp}; 1029 Error -> throw(Error) 1030 end; 1031 {error,Reason} -> 1032 throw({gen_tcp_error, Reason}) 1033 end. 1034 1035%%% Check for expected kind of reply 1036check_reply(Data, {ok,Msg}, Op) when 1037 Msg#'LDAPMessage'.messageID == Data#eldap.id -> 1038 case Msg#'LDAPMessage'.protocolOp of 1039 {Op, Result} -> 1040 case Result#'LDAPResult'.resultCode of 1041 success -> {ok,Data}; 1042 referral -> {{ok, {referral,Result#'LDAPResult'.referral}}, Data}; 1043 Error -> {error, Error} 1044 end; 1045 Other -> {error, Other} 1046 end; 1047check_reply(_, Error, _) -> 1048 {error, Error}. 1049 1050 1051%%% -------------------------------------------------------------------- 1052%%% Verify the input data 1053%%% -------------------------------------------------------------------- 1054 1055v_filter({'and',L}) -> {'and',L}; 1056v_filter({'or', L}) -> {'or',L}; 1057v_filter({'not',L}) -> {'not',L}; 1058v_filter({equalityMatch,AV}) -> {equalityMatch,AV}; 1059v_filter({greaterOrEqual,AV}) -> {greaterOrEqual,AV}; 1060v_filter({lessOrEqual,AV}) -> {lessOrEqual,AV}; 1061v_filter({approxMatch,AV}) -> {approxMatch,AV}; 1062v_filter({present,A}) -> {present,A}; 1063v_filter({substrings,S}) when is_record(S,'SubstringFilter') -> {substrings,S}; 1064v_filter({extensibleMatch,S}) when is_record(S,'MatchingRuleAssertion') -> {extensibleMatch,S}; 1065v_filter(_Filter) -> throw({error,concat(["unknown filter: ",_Filter])}). 1066 1067v_modifications(Mods) -> 1068 F = fun({_,Op,_}) -> 1069 case lists:member(Op,[add,delete,replace]) of 1070 true -> true; 1071 _ -> throw({error,{mod_operation,Op}}) 1072 end 1073 end, 1074 lists:foreach(F, Mods). 1075 1076v_substr([{Key,Str}|T]) when is_list(Str),Key==initial;Key==any;Key==final -> 1077 [{Key,Str}|v_substr(T)]; 1078v_substr([H|_]) -> 1079 throw({error,{substring_arg,H}}); 1080v_substr([]) -> 1081 []. 1082v_scope(baseObject) -> baseObject; 1083v_scope(singleLevel) -> singleLevel; 1084v_scope(wholeSubtree) -> wholeSubtree; 1085v_scope(_Scope) -> throw({error,concat(["unknown scope: ",_Scope])}). 1086 1087v_deref(DR = neverDerefAliases) -> DR; 1088v_deref(DR = derefInSearching) -> DR; 1089v_deref(DR = derefFindingBaseObj) -> DR; 1090v_deref(DR = derefAlways ) -> DR. 1091 1092v_bool(true) -> true; 1093v_bool(false) -> false; 1094v_bool(_Bool) -> throw({error,concat(["not Boolean: ",_Bool])}). 1095 1096v_size_limit(I) when is_integer(I), I>=0 -> I; 1097v_size_limit(_I) -> throw({error,concat(["size_limit not positive integer: ",_I])}). 1098 1099v_timeout(I) when is_integer(I), I>=0 -> I; 1100v_timeout(_I) -> throw({error,concat(["timeout not positive integer: ",_I])}). 1101 1102v_attributes(Attrs) -> 1103 F = fun(A) when is_list(A) -> A; 1104 (A) -> throw({error,concat(["attribute not String: ",A])}) 1105 end, 1106 lists:map(F,Attrs). 1107 1108 1109%%% -------------------------------------------------------------------- 1110%%% Log routines. Call a user provided log routine F. 1111%%% -------------------------------------------------------------------- 1112 1113%log1(Data, Str, Args) -> log(Data, Str, Args, 1). 1114log2(Data, Str, Args) -> log(Data, Str, Args, 2). 1115 1116log(Data, Str, Args, Level) when is_function(Data#eldap.log) -> 1117 catch (Data#eldap.log)(Level, Str, Args); 1118log(_, _, _, _) -> 1119 ok. 1120 1121 1122%%% -------------------------------------------------------------------- 1123%%% Misc. routines 1124%%% -------------------------------------------------------------------- 1125 1126send(To,Msg) -> 1127 To ! {self(), Msg}, 1128 ok. 1129 1130recv(From) -> 1131 receive 1132 {From, Msg} -> Msg; 1133 {'EXIT', From, Reason} -> 1134 {error, {internal_error, Reason}} 1135 end. 1136 1137ldap_closed_p(Data, Emsg) when Data#eldap.using_tls == true -> 1138 %% Check if the SSL socket seems to be alive or not 1139 case catch ssl:sockname(Data#eldap.fd) of 1140 {error, _} -> 1141 _ = ssl:close(Data#eldap.fd), 1142 {error, ldap_closed}; 1143 {ok, _} -> 1144 {error, Emsg}; 1145 _ -> 1146 %% sockname crashes if the socket pid is not alive 1147 {error, ldap_closed} 1148 end; 1149ldap_closed_p(Data, Emsg) -> 1150 %% non-SSL socket 1151 case inet:port(Data#eldap.fd) of 1152 {error,_} -> {error, ldap_closed}; 1153 _ -> {error,Emsg} 1154 end. 1155 1156bump_id(Data) -> Data#eldap.id + 1. 1157 1158 1159%%% -------------------------------------------------------------------- 1160%%% parse_dn/1 - Implementation of RFC 2253: 1161%%% 1162%%% "UTF-8 String Representation of Distinguished Names" 1163%%% 1164%%% Test cases: 1165%%% 1166%%% The simplest case: 1167%%% 1168%%% 1> eldap:parse_dn("CN=Steve Kille,O=Isode Limited,C=GB"). 1169%%% {ok,[[{attribute_type_and_value,"CN","Steve Kille"}], 1170%%% [{attribute_type_and_value,"O","Isode Limited"}], 1171%%% [{attribute_type_and_value,"C","GB"}]]} 1172%%% 1173%%% The first RDN is multi-valued: 1174%%% 1175%%% 2> eldap:parse_dn("OU=Sales+CN=J. Smith,O=Widget Inc.,C=US"). 1176%%% {ok,[[{attribute_type_and_value,"OU","Sales"}, 1177%%% {attribute_type_and_value,"CN","J. Smith"}], 1178%%% [{attribute_type_and_value,"O","Widget Inc."}], 1179%%% [{attribute_type_and_value,"C","US"}]]} 1180%%% 1181%%% Quoting a comma: 1182%%% 1183%%% 3> eldap:parse_dn("CN=L. Eagle,O=Sue\\, Grabbit and Runn,C=GB"). 1184%%% {ok,[[{attribute_type_and_value,"CN","L. Eagle"}], 1185%%% [{attribute_type_and_value,"O","Sue\\, Grabbit and Runn"}], 1186%%% [{attribute_type_and_value,"C","GB"}]]} 1187%%% 1188%%% A value contains a carriage return: 1189%%% 1190%%% 4> eldap:parse_dn("CN=Before 1191%%% 4> After,O=Test,C=GB"). 1192%%% {ok,[[{attribute_type_and_value,"CN","Before\nAfter"}], 1193%%% [{attribute_type_and_value,"O","Test"}], 1194%%% [{attribute_type_and_value,"C","GB"}]]} 1195%%% 1196%%% 5> eldap:parse_dn("CN=Before\\0DAfter,O=Test,C=GB"). 1197%%% {ok,[[{attribute_type_and_value,"CN","Before\\0DAfter"}], 1198%%% [{attribute_type_and_value,"O","Test"}], 1199%%% [{attribute_type_and_value,"C","GB"}]]} 1200%%% 1201%%% An RDN in OID form: 1202%%% 1203%%% 6> eldap:parse_dn("1.3.6.1.4.1.1466.0=#04024869,O=Test,C=GB"). 1204%%% {ok,[[{attribute_type_and_value,"1.3.6.1.4.1.1466.0","#04024869"}], 1205%%% [{attribute_type_and_value,"O","Test"}], 1206%%% [{attribute_type_and_value,"C","GB"}]]} 1207%%% 1208%%% 1209%%% -------------------------------------------------------------------- 1210 1211parse_dn("") -> % empty DN string 1212 {ok,[]}; 1213parse_dn([H|_] = Str) when H=/=$, -> % 1:st name-component ! 1214 case catch parse_name(Str,[]) of 1215 {'EXIT',Reason} -> {parse_error,internal_error,Reason}; 1216 Else -> Else 1217 end. 1218 1219parse_name("",Acc) -> 1220 {ok,lists:reverse(Acc)}; 1221parse_name([$,|T],Acc) -> % N:th name-component ! 1222 parse_name(T,Acc); 1223parse_name(Str,Acc) -> 1224 {Rest,NameComponent} = parse_name_component(Str), 1225 parse_name(Rest,[NameComponent|Acc]). 1226 1227parse_name_component(Str) -> 1228 parse_name_component(Str,[]). 1229 1230parse_name_component(Str,Acc) -> 1231 case parse_attribute_type_and_value(Str) of 1232 {[$+|Rest], ATV} -> 1233 parse_name_component(Rest,[ATV|Acc]); 1234 {Rest,ATV} -> 1235 {Rest,lists:reverse([ATV|Acc])} 1236 end. 1237 1238parse_attribute_type_and_value(Str) -> 1239 case parse_attribute_type(Str) of 1240 {_Rest,[]} -> 1241 parse_error(expecting_attribute_type,Str); 1242 {Rest,Type} -> 1243 Rest2 = parse_equal_sign(Rest), 1244 {Rest3,Value} = parse_attribute_value(Rest2), 1245 {Rest3,{attribute_type_and_value,Type,Value}} 1246 end. 1247 1248-define(IS_ALPHA(X) , X>=$a,X=<$z;X>=$A,X=<$Z ). 1249-define(IS_DIGIT(X) , X>=$0,X=<$9 ). 1250-define(IS_SPECIAL(X) , X==$,;X==$=;X==$+;X==$<;X==$>;X==$#;X==$; ). 1251-define(IS_QUOTECHAR(X) , X=/=$\\,X=/=$" ). 1252-define(IS_STRINGCHAR(X) , 1253 X=/=$,,X=/=$=,X=/=$+,X=/=$<,X=/=$>,X=/=$#,X=/=$;,?IS_QUOTECHAR(X) ). 1254-define(IS_HEXCHAR(X) , ?IS_DIGIT(X);X>=$a,X=<$f;X>=$A,X=<$F ). 1255 1256parse_attribute_type([H|T]) when ?IS_ALPHA(H) -> 1257 %% NB: It must be an error in the RFC in the definition 1258 %% of 'attributeType', should be: (ALPHA *keychar) 1259 {Rest,KeyChars} = parse_keychars(T), 1260 {Rest,[H|KeyChars]}; 1261parse_attribute_type([H|_] = Str) when ?IS_DIGIT(H) -> 1262 parse_oid(Str); 1263parse_attribute_type(Str) -> 1264 parse_error(invalid_attribute_type,Str). 1265 1266 1267 1268%%% Is a hexstring ! 1269parse_attribute_value([$#,X,Y|T]) when ?IS_HEXCHAR(X),?IS_HEXCHAR(Y) -> 1270 {Rest,HexString} = parse_hexstring(T), 1271 {Rest,[$#,X,Y|HexString]}; 1272%%% Is a "quotation-sequence" ! 1273parse_attribute_value([$"|T]) -> 1274 {Rest,Quotation} = parse_quotation(T), 1275 {Rest,[$"|Quotation]}; 1276%%% Is a stringchar , pair or Empty ! 1277parse_attribute_value(Str) -> 1278 parse_string(Str). 1279 1280parse_hexstring(Str) -> 1281 parse_hexstring(Str,[]). 1282 1283parse_hexstring([X,Y|T],Acc) when ?IS_HEXCHAR(X),?IS_HEXCHAR(Y) -> 1284 parse_hexstring(T,[Y,X|Acc]); 1285parse_hexstring(T,Acc) -> 1286 {T,lists:reverse(Acc)}. 1287 1288parse_quotation([$"|T]) -> % an empty: "" is ok ! 1289 {T,[$"]}; 1290parse_quotation(Str) -> 1291 parse_quotation(Str,[]). 1292 1293%%% Parse to end of quotation 1294parse_quotation([$"|T],Acc) -> 1295 {T,lists:reverse([$"|Acc])}; 1296parse_quotation([X|T],Acc) when ?IS_QUOTECHAR(X) -> 1297 parse_quotation(T,[X|Acc]); 1298parse_quotation([$\\,X|T],Acc) when ?IS_SPECIAL(X) -> 1299 parse_quotation(T,[X,$\\|Acc]); 1300parse_quotation([$\\,$\\|T],Acc) -> 1301 parse_quotation(T,[$\\,$\\|Acc]); 1302parse_quotation([$\\,$"|T],Acc) -> 1303 parse_quotation(T,[$",$\\|Acc]); 1304parse_quotation([$\\,X,Y|T],Acc) when ?IS_HEXCHAR(X),?IS_HEXCHAR(Y) -> 1305 parse_quotation(T,[Y,X,$\\|Acc]); 1306parse_quotation(T,_) -> 1307 parse_error(expecting_double_quote_mark,T). 1308 1309parse_string(Str) -> 1310 parse_string(Str,[]). 1311 1312parse_string("",Acc) -> 1313 {"",lists:reverse(Acc)}; 1314parse_string([H|T],Acc) when ?IS_STRINGCHAR(H) -> 1315 parse_string(T,[H|Acc]); 1316parse_string([$\\,X|T],Acc) when ?IS_SPECIAL(X) -> % is a pair ! 1317 parse_string(T,[X,$\\|Acc]); 1318parse_string([$\\,$\\|T],Acc) -> % is a pair ! 1319 parse_string(T,[$\\,$\\|Acc]); 1320parse_string([$\\,$" |T],Acc) -> % is a pair ! 1321 parse_string(T,[$" ,$\\|Acc]); 1322parse_string([$\\,X,Y|T],Acc) when ?IS_HEXCHAR(X),?IS_HEXCHAR(Y) -> % is a pair! 1323 parse_string(T,[Y,X,$\\|Acc]); 1324parse_string(T,Acc) -> 1325 {T,lists:reverse(Acc)}. 1326 1327parse_equal_sign([$=|T]) -> T; 1328parse_equal_sign(T) -> parse_error(expecting_equal_sign,T). 1329 1330parse_keychars(Str) -> parse_keychars(Str,[]). 1331 1332parse_keychars([H|T],Acc) when ?IS_ALPHA(H) -> parse_keychars(T,[H|Acc]); 1333parse_keychars([H|T],Acc) when ?IS_DIGIT(H) -> parse_keychars(T,[H|Acc]); 1334parse_keychars([$-|T],Acc) -> parse_keychars(T,[$-|Acc]); 1335parse_keychars(T,Acc) -> {T,lists:reverse(Acc)}. 1336 1337parse_oid(Str) -> parse_oid(Str,[]). 1338 1339parse_oid([H,$.|T], Acc) when ?IS_DIGIT(H) -> 1340 parse_oid(T,[$.,H|Acc]); 1341parse_oid([H|T], Acc) when ?IS_DIGIT(H) -> 1342 parse_oid(T,[H|Acc]); 1343parse_oid(T, Acc) -> 1344 {T,lists:reverse(Acc)}. 1345 1346parse_error(Emsg,Rest) -> 1347 throw({parse_error,Emsg,Rest}). 1348 1349 1350%%% -------------------------------------------------------------------- 1351%%% Parse LDAP url according to RFC 2255 1352%%% 1353%%% Test case: 1354%%% 1355%%% 2> eldap:parse_ldap_url("ldap://10.42.126.33:389/cn=Administrative%20CA,o=Post%20Danmark,c=DK?certificateRevokationList;binary"). 1356%%% {ok,{{10,42,126,33},389}, 1357%%% [[{attribute_type_and_value,"cn","Administrative%20CA"}], 1358%%% [{attribute_type_and_value,"o","Post%20Danmark"}], 1359%%% [{attribute_type_and_value,"c","DK"}]], 1360%%% {attributes,["certificateRevokationList;binary"]}} 1361%%% 1362%%% -------------------------------------------------------------------- 1363 1364parse_ldap_url("ldap://" ++ Rest1 = Str) -> 1365 {Rest2,HostPort} = parse_hostport(Rest1), 1366 %% Split the string into DN and Attributes+etc 1367 {Sdn,Rest3} = split_string(rm_leading_slash(Rest2),$?), 1368 case parse_dn(Sdn) of 1369 {parse_error,internal_error,_Reason} -> 1370 {parse_error,internal_error,{Str,[]}}; 1371 {parse_error,Emsg,Tail} -> 1372 Head = get_head(Str,Tail), 1373 {parse_error,Emsg,{Head,Tail}}; 1374 {ok,DN} -> 1375 %% We stop parsing here for now and leave 1376 %% 'scope', 'filter' and 'extensions' to 1377 %% be implemented later if needed. 1378 {_Rest4,Attributes} = parse_attributes(Rest3), 1379 {ok,HostPort,DN,Attributes} 1380 end. 1381 1382rm_leading_slash([$/|Tail]) -> Tail; 1383rm_leading_slash(Tail) -> Tail. 1384 1385parse_attributes([$?|Tail]) -> 1386 case split_string(Tail,$?) of 1387 {[],Attributes} -> 1388 {[],{attributes,string:lexemes(Attributes,",")}}; 1389 {Attributes,Rest} -> 1390 {Rest,{attributes,string:lexemes(Attributes,",")}} 1391 end. 1392 1393parse_hostport(Str) -> 1394 {HostPort,Rest} = split_string(Str,$/), 1395 case split_string(HostPort,$:) of 1396 {Shost,[]} -> 1397 {Rest,{parse_host(Rest,Shost),?LDAP_PORT}}; 1398 {Shost,[$:|Sport]} -> 1399 {Rest,{parse_host(Rest,Shost), 1400 parse_port(Rest,Sport)}} 1401 end. 1402 1403parse_port(Rest,Sport) -> 1404 try list_to_integer(Sport) 1405 catch _:_ -> parse_error(parsing_port,Rest) 1406 end. 1407 1408parse_host(Rest,Shost) -> 1409 case catch validate_host(Shost) of 1410 {parse_error,Emsg,_} -> parse_error(Emsg,Rest); 1411 Host -> Host 1412 end. 1413 1414validate_host(Shost) -> 1415 case inet_parse:address(Shost) of 1416 {ok,Host} -> Host; 1417 _ -> 1418 case inet_parse:domain(Shost) of 1419 true -> Shost; 1420 _ -> parse_error(parsing_host,Shost) 1421 end 1422 end. 1423 1424 1425split_string(Str,Key) -> 1426 Pred = fun(X) when X==Key -> false; (_) -> true end, 1427 lists:splitwith(Pred, Str). 1428 1429get_head(Str,Tail) -> 1430 get_head(Str,Tail,[]). 1431 1432%%% Should always succeed ! 1433get_head([H|Tail],Tail,Rhead) -> lists:reverse([H|Rhead]); 1434get_head([H|Rest],Tail,Rhead) -> get_head(Rest,Tail,[H|Rhead]). 1435