Add LDAP test cases

test/ejabberd_SUITE.erl

@@ -69,6 +69,7 @@
 -define(MNESIA_VHOST, <<"mnesia.localhost">>).
 -define(MYSQL_VHOST, <<"mysql.localhost">>).
 -define(PGSQL_VHOST, <<"pgsql.localhost">>).
+-define(LDAP_VHOST, <<"ldap.localhost">>).
 
 suite() ->
     [{timetrap, {seconds,10}}].
@@ -83,6 +84,7 @@ init_per_suite(Config) ->
     SASLPath = filename:join([PrivDir, "sasl.log"]),
     MnesiaDir = filename:join([PrivDir, "mnesia"]),
     CertFile = filename:join([DataDir, "cert.pem"]),
+    LDIFFile = filename:join([DataDir, "ejabberd.ldif"]),
     {ok, CWD} = file:get_cwd(),
     {ok, _} = file:copy(CertFile, filename:join([CWD, "cert.pem"])),
     application:set_env(ejabberd, config, ConfigPath),
@@ -96,6 +98,7 @@ init_per_suite(Config) ->
      {user, <<"test_single">>},
      {certfile, CertFile},
      {base_dir, BaseDir},
+     {ldif_file, LDIFFile},
      {resource, <<"resource">>},
      {password, <<"password">>}
      |Config].
@@ -130,6 +133,9 @@ init_per_group(pgsql, Config) ->
         Err ->
             {skip, {pgsql_not_available, Err}}
     end;
+init_per_group(ldap, Config) ->
+    {ok, _} = ldap_srv:start(?config(ldif_file, Config)),
+    set_opt(server, ?LDAP_VHOST, Config);
 init_per_group(_GroupName, Config) ->
     Pid = start_event_relay(),
     set_opt(event_relay, Pid, Config).
@@ -142,6 +148,8 @@ end_per_group(pgsql, _Config) ->
     ok;
 end_per_group(no_db, _Config) ->
     ok;
+end_per_group(ldap, _Config) ->
+    ok;
 end_per_group(_GroupName, Config) ->
     stop_event_relay(Config),
     ok.
@@ -194,7 +202,7 @@ init_per_testcase(TestCase, OrigConfig) ->
 end_per_testcase(_TestCase, _Config) ->
     ok.
 
-generic_tests() ->
+no_db_tests() ->
     [{generic, [sequence],
       [test_connect,
        test_starttls,
@@ -211,7 +219,7 @@ generic_tests() ->
      {test_proxy65, [parallel],
       [proxy65_master, proxy65_slave]}].
 
-tests() ->
+db_tests() ->
     [{single_user, [sequence],
       [test_register,
        auth_plain,
@@ -235,14 +243,21 @@ tests() ->
       [roster_remove_master,
        roster_remove_slave]}].
 
+ldap_tests() ->
+    [{ldap_tests, [sequence],
+      [test_auth,
+       vcard_get]}].
+
 groups() ->
-    [{no_db, [sequence], generic_tests()},
+    [{ldap, [sequence], ldap_tests()},
-     {mnesia, [sequence], tests()},
+     {no_db, [sequence], no_db_tests()},
-     {mysql, [sequence], tests()},
+     {mnesia, [sequence], db_tests()},
-     {pgsql, [sequence], tests()}].
+     {mysql, [sequence], db_tests()},
+     {pgsql, [sequence], db_tests()}].
 
 all() ->
-    [{group, no_db},
+    [{group, ldap},
+     {group, no_db},
      {group, mnesia},
      {group, mysql},
      {group, pgsql},
@@ -617,6 +632,13 @@ vcard(Config) ->
         send_recv(Config, #iq{type = get, sub_els = [#vcard{}]}),
     disconnect(Config).
 
+vcard_get(Config) ->
+    true = is_feature_advertised(Config, ?NS_VCARD),
+    %% TODO: check if VCard corresponds to LDIF data from ejabberd.ldif
+    #iq{type = result, sub_els = [_VCard]} =
+        send_recv(Config, #iq{type = get, sub_els = [#vcard{}]}),
+    disconnect(Config).
+
 stats(Config) ->
     #iq{type = result, sub_els = [#stats{stat = Stats}]} =
         send_recv(Config, #iq{type = get, sub_els = [#stats{}],

test/ejabberd_SUITE_data/ejabberd.cfg

@@ -1,5 +1,9 @@
 {loglevel, 4}.
-{hosts, ["localhost", "mnesia.localhost", "mysql.localhost", "pgsql.localhost"]}.
+{hosts, ["localhost",
+         "mnesia.localhost",
+         "mysql.localhost",
+         "pgsql.localhost",
+         "ldap.localhost"]}.
 {define_macro, 'CERTFILE', "cert.pem"}.
 {listen,
  [
@@ -116,6 +120,15 @@
                     {mod_roster,      [{db_type, odbc}]},
                     {mod_vcard,       [{db_type, odbc}]}]}
  ]}.
+{host_config, "ldap.localhost",
+ [{auth_method, ldap},
+  {ldap_servers, ["localhost"]},
+  {ldap_port, 1389},
+  {ldap_rootdn, "cn=admin,dc=localhost"},
+  {ldap_password, "password"},
+  {ldap_base, "ou=users,dc=localhost"},
+  {{add, modules}, [{mod_vcard_ldap, []}]}
+ ]}.
 
 %%% Local Variables:
 %%% mode: erlang

test/ejabberd_SUITE_data/ejabberd.ldif

@@ -0,0 +1,35 @@
+dn: dc=localhost
+dc: localhost
+objectclass: dcObject
+
+dn: cn=admin,dc=localhost
+cn: admin
+objectclass: organizationalRole
+
+dn: ou=users,dc=localhost
+ou: users
+objectClass: organizationalUnit
+
+dn: uid=test_single,ou=users,dc=localhost
+uid: test_single
+mail: test_single@localhost
+objectClass: person
+jpegPhoto:: /9g=
+cn: Test Single
+password: password
+
+dn: uid=test_master,ou=users,dc=localhost
+uid: test_master
+mail: test_master@localhost
+objectClass: person
+jpegPhoto:: /9g=
+cn: Test Master
+password: password
+
+dn: uid=test_slave,ou=users,dc=localhost
+uid: test_slave
+mail: test_slave@localhost
+objectClass: person
+jpegPhoto:: /9g=
+cn: Test Slave
+password: password

test/ldap_srv.erl

@@ -0,0 +1,453 @@
+%%%-------------------------------------------------------------------
+%%% @author Evgeniy Khramtsov <ekhramtsov@process-one.net>
+%%% @copyright (C) 2013, Evgeniy Khramtsov
+%%% @doc
+%%%     Simple LDAP server intended for LDAP modules testing
+%%% @end
+%%% Created : 21 Jun 2013 by Evgeniy Khramtsov <ekhramtsov@process-one.net>
+%%%-------------------------------------------------------------------
+-module(ldap_srv).
+
+-behaviour(gen_server).
+
+%% API
+-export([start/1,
+         load_ldif/1,
+         equalityMatch/3,
+         greaterOrEqual/3,
+         lessOrEqual/3,
+         approxMatch/3]).
+
+%% gen_server callbacks
+-export([init/1, handle_call/3, handle_cast/2, handle_info/2,
+         terminate/2, code_change/3]).
+
+-include("logger.hrl").
+-include("ELDAPv3.hrl").
+
+-define(TCP_SEND_TIMEOUT, 32000).
+-define(SERVER, ?MODULE). 
+
+-record(state, {listener = make_ref() :: reference()}).
+
+%%%===================================================================
+%%% API
+%%%===================================================================
+start(LDIFFile) ->
+    gen_server:start({local, ?SERVER}, ?MODULE, [LDIFFile], []).
+
+%%%===================================================================
+%%% gen_server callbacks
+%%%===================================================================
+init([LDIFFile]) ->
+    case gen_tcp:listen(1389, [binary,
+                               {packet, asn1},
+                               {active, false},
+                               {reuseaddr, true},
+                               {nodelay, true},
+                               {send_timeout, ?TCP_SEND_TIMEOUT},
+                               {send_timeout_close, true},
+                               {keepalive, true}]) of
+        {ok, ListenSocket} ->
+            case load_ldif(LDIFFile) of
+                {ok, Tree} ->
+                    ?INFO_MSG("LDIF tree loaded, "
+                              "ready to accept connections", []),
+                    {_Pid, MRef} =
+                        spawn_monitor(
+                          fun() -> accept(ListenSocket, Tree) end
+                         ),
+                    {ok, #state{listener = MRef}};
+                {error, Reason} ->
+                    {stop, Reason}
+            end;
+        {error, Reason} = Err ->
+            ?ERROR_MSG("failed to fetch sockname: ~p", [Err]),
+            {stop, Reason}
+    end.
+
+handle_call(_Request, _From, State) ->
+    Reply = ok,
+    {reply, Reply, State}.
+
+handle_cast(_Msg, State) ->
+    {noreply, State}.
+
+handle_info({'DOWN', MRef, _Type, _Object, Info},
+            #state{listener = MRef} = State) ->
+    ?CRITICAL_MSG("listener died with reason ~p, terminating",
+                  [Info]),
+    {stop, normal, State};
+handle_info(_Info, State) ->
+    {noreply, State}.
+
+terminate(_Reason, _State) ->
+    ok.
+
+code_change(_OldVsn, State, _Extra) ->
+    {ok, State}.
+
+%%%===================================================================
+%%% Internal functions
+%%%===================================================================
+accept(ListenSocket, Tree) ->
+    case gen_tcp:accept(ListenSocket) of
+	{ok, Socket} ->
+            spawn(fun() -> process(Socket, Tree) end),
+            accept(ListenSocket, Tree);
+        Err ->
+            ?ERROR_MSG("failed to accept: ~p", [Err]),
+	    Err
+    end.
+
+process(Socket, Tree) ->
+    case gen_tcp:recv(Socket, 0) of
+        {ok, B} ->
+            case asn1rt:decode('ELDAPv3', 'LDAPMessage', B) of
+                {ok, Msg} ->
+                    Replies = process_msg(Msg, Tree),
+                    Id = Msg#'LDAPMessage'.messageID,
+                    lists:foreach(
+                      fun(ReplyOp) ->
+                              Reply = #'LDAPMessage'{messageID = Id,
+                                                     protocolOp = ReplyOp},
+                              ?DEBUG("sent:~n~p", [Reply]),
+                              {ok, Bytes} = asn1rt:encode(
+                                              'ELDAPv3', 'LDAPMessage', Reply),
+                              gen_tcp:send(Socket, Bytes)
+                      end, Replies),
+                    process(Socket, Tree);
+                Err ->
+                    ?ERROR_MSG("failed to decode msg: ~p", [Err]),
+                    Err
+            end;
+        Err ->
+            Err
+    end.
+
+process_msg(#'LDAPMessage'{protocolOp = Op} = Msg, TopTree) ->
+    ?DEBUG("got:~n~p", [Msg]),
+    case Op of
+        {bindRequest,
+         #'BindRequest'{name = DN}} ->
+            ResCode = case find_obj(DN, TopTree) of
+                          {ok, _} ->
+                              success;
+                          error ->
+                              invalidCredentials
+                              %%success
+                      end,
+            [{bindResponse,
+              #'BindResponse'{resultCode = ResCode,
+                              matchedDN = <<"">>,
+                              errorMessage = <<"">>}}];
+        {searchRequest,
+         #'SearchRequest'{baseObject = DN,
+                          scope = Scope,
+                          filter = Filter,
+                          attributes = Attrs}} ->
+            DNs = process_dn_filter(DN, Scope, Filter, TopTree),
+            Es = lists:map(
+                   fun(D) ->
+                           make_entry(D, TopTree, Attrs)
+                   end, DNs),
+            Es ++ [{searchResDone,
+                    #'LDAPResult'{resultCode = success,
+                                  matchedDN = <<"">>,
+                                  errorMessage = <<"">>}}];
+        {extendedReq, _} ->
+            [{extendedResp,
+              #'ExtendedResponse'{matchedDN = <<"">>,
+                                  errorMessage = <<"Not Implemented">>,
+                                  resultCode = operationsError}}];
+        _ ->
+            RespOp = case Op of
+                         {modifyRequest, _} -> modifyResponse;
+                         {addRequest, _} -> addResponse;
+                         {delRequest, _} -> delResponse;
+                         {modDNRequest, _} -> modDNResponse;
+                         {compareRequest, _} -> compareResponse;
+                         _ -> undefined
+                     end,
+            case RespOp of
+                undefined ->
+                    [];
+                _ ->
+                    [{RespOp,
+                      #'LDAPResult'{matchedDN = <<"">>,
+                                    errorMessage = <<"Not implemented">>,
+                                    resultCode = operationsError}}]
+            end
+    end.
+
+make_entry(DN, Tree, Attrs) ->
+    KVs = case ets:lookup(Tree, {dn, DN}) of
+              [{_, _KVs}|_] ->
+                  _KVs;
+              _ ->
+                  []
+          end,
+    NewKVs = if Attrs /= [], Attrs /= [<<"*">>] ->
+                     lists:filter(
+                       fun({A, _V}) ->
+                               member(A, Attrs)
+                       end, KVs);
+                true ->
+                     KVs
+             end,
+    KVs1 = dict:to_list(
+             lists:foldl(
+               fun({A, V}, D) ->
+                       dict:append(A, V, D)
+               end, dict:new(), NewKVs)),
+    {searchResEntry,
+     #'SearchResultEntry'{
+       objectName = str:join(DN, <<",">>),
+       attributes = [#'PartialAttributeList_SEQOF'{type = T, vals = V}
+                     || {T, V} <- KVs1]}}.
+
+process_dn_filter(DN, Level, F, Tree) ->
+    DN1 = str:tokens(DN, <<",">>),
+    Fun = filter_to_fun(F),
+    filter(Fun, DN1, Tree, Level).
+
+filter_to_fun({'and', Fs}) ->
+    fun(KVs) ->
+            lists:all(
+              fun(F) ->
+                      (filter_to_fun(F))(KVs)
+              end, Fs)
+    end;
+filter_to_fun({'or', Fs}) ->
+    fun(KVs) ->
+            lists:any(
+              fun(F) ->
+                      (filter_to_fun(F))(KVs)
+              end, Fs)
+    end;
+filter_to_fun({present, Attr}) ->
+    fun(KVs) -> present(Attr, KVs) end;
+filter_to_fun({Tag, #'AttributeValueAssertion'{attributeDesc = Attr,
+                                               assertionValue = Val}})
+  when Tag == equalityMatch; Tag == greaterOrEqual;
+       Tag == lessOrEqual; Tag == approxMatch ->
+    fun(KVs) ->
+            apply(?MODULE, Tag, [Attr, Val, KVs])
+    end;
+filter_to_fun({substrings,
+               #'SubstringFilter'{type = A, substrings = Ss}}) ->
+    Re = substrings_to_regexp(Ss),
+    fun(KVs) -> substrings(A, Re, KVs) end;
+filter_to_fun({'not', F}) ->
+    fun(KVs) -> not (filter_to_fun(F))(KVs) end.
+
+find_obj(DN, Tree) ->
+    case ets:lookup(Tree, {dn, str:tokens(DN, <<",">>)}) of
+        [{_, Obj}|_] ->
+            {ok, Obj};
+        [] ->
+            error
+    end.
+
+present(A, R) ->
+    case keyfind(A, R) of
+        [] ->
+            false;
+        _ ->
+            true
+    end.
+
+equalityMatch(A, V, R) ->
+    Vs = keyfind(A, R),
+    member(V, Vs).
+
+lessOrEqual(A, V, R) ->
+    lists:any(
+      fun(X) ->
+              str:to_lower(X) =< str:to_lower(V)
+      end, keyfind(A, R)).
+
+greaterOrEqual(A, V, R) ->
+    lists:any(
+      fun(X) ->
+              str:to_lower(X) >= str:to_lower(V)
+      end, keyfind(A, R)).
+
+approxMatch(A, V, R) ->
+    equalityMatch(A, V, R).
+
+substrings(A, Re, R) ->
+    lists:any(
+      fun(V) ->
+              case re:run(str:to_lower(V), Re) of
+                  {match, _} ->
+                      true;
+                  _ ->
+                      false
+              end
+      end, keyfind(A, R)).
+
+substrings_to_regexp(Ss) ->
+    ReS = lists:map(
+            fun({initial, S}) ->
+                    [S, <<".*">>];
+               ({any, S}) ->
+                    [<<".*">>, S, <<".*">>];
+               ({final, S}) ->
+                    [<<".*">>, S]
+            end, Ss),
+    ReS1 = str:to_lower(list_to_binary([$^, ReS, $$])),
+    {ok, Re} = re:compile(ReS1),
+    Re.
+
+filter(F, BaseDN, Tree, Level) ->
+    KVs = case ets:lookup(Tree, {dn, BaseDN}) of
+              [{_, _KVs}|_] ->
+                  _KVs;
+              [] ->
+                  []
+          end,
+    Rest = case Level of
+               baseObject ->
+                   [];
+               _ ->
+                   NewLevel = if Level /= wholeSubtree ->
+                                      baseObject;
+                                 true ->
+                                      Level
+                              end,
+                   lists:flatmap(
+                     fun({_, D}) ->
+                             NewDN = if BaseDN == [] ->
+                                             D;
+                                        true ->
+                                             [D|BaseDN]
+                                     end,
+                             filter(F, NewDN, Tree, NewLevel)
+                     end, ets:lookup(Tree, BaseDN))
+           end,
+    if BaseDN == [], Level /= baseObject ->
+            Rest;
+       true ->
+            case F(KVs) of
+                true ->
+                    [BaseDN|Rest];
+                false ->
+                    Rest
+            end
+    end.
+
+keyfind(K, KVs) ->
+    keyfind(str:to_lower(K), KVs, []).
+
+keyfind(K, [{K1, V}|T], Acc) ->
+    case str:to_lower(K1) of
+        K ->
+            keyfind(K, T, [V|Acc]);
+        _ ->
+            keyfind(K, T, Acc)
+    end;
+keyfind(_, [], Acc) ->
+    Acc.
+
+member(E, Es) ->
+    member1(str:to_lower(E), Es).
+
+member1(E, [H|T]) ->
+    case str:to_lower(H) of
+        E ->
+            true;
+        _ ->
+            member1(E, T)
+    end;
+member1(_, []) ->
+    false.
+
+load_ldif(Path) ->
+    case file:open(Path, [read, binary]) of
+        {ok, Fd} ->
+            {ok, resort(format(read_lines(Fd, []), [], []))};
+        Err ->
+            ?ERROR_MSG("failed to read LDIF file: ~p", [Err]),
+            Err
+    end.
+
+read_lines(Fd, Acc) ->
+    case file:read_line(Fd) of
+        {ok, Str} ->
+            Line = process_line(str:strip(Str, right, $\n)),
+            read_lines(Fd, [Line|Acc]);
+        eof ->
+            Acc;
+        Err ->
+            Err
+    end.
+
+process_line(<<C, _/binary>> = L) when C/=$ , C/=$\t, C/=$\n ->
+    case str:chr(L, $:) of
+        0 ->
+            <<>>;
+        Pos ->
+            NewPos = Pos - 1,
+            case L of
+                <<Val:NewPos/binary, $:, $:, Rest/binary>> ->
+                    {Val, base64, str:strip(Rest, left, $ )};
+                <<Val:NewPos/binary, $:, Rest/binary>> ->
+                    {Val, plain, str:strip(Rest, left, $ )}
+            end
+    end;
+process_line([_|L]) ->
+    L;
+process_line(_) ->
+    <<>>.
+
+format([{Val, Type, L}|T], Ls, Acc) ->
+    Str1 = iolist_to_binary([L|Ls]),
+    Str2 = case Type of
+               plain -> Str1;
+               base64 -> base64:decode(Str1)
+           end,
+    format(T, [], [{Val, Str2}|Acc]);
+format([<<"-">>|T], Ls, Acc) ->
+    format(T, Ls, Acc);
+format([L|T], Ls, Acc) ->
+    format(T, [L|Ls], Acc);
+format([], _, Acc) ->
+    lists:reverse(Acc).
+
+resort(T) ->
+    resort(T, [], [], ets:new(ldap_tree, [named_table, public, bag])).
+
+resort([{<<"dn">>, S}|T], Ls, DNs, Tree) ->
+    case proplists:get_value(<<"changetype">>, Ls, <<"add">>) of
+        <<"add">> ->
+            [H|Rest] = DN = str:tokens(S, <<",">>),
+            ets:insert(Tree, {{dn, DN}, Ls}),
+            ets:insert(Tree, {Rest, H}),
+            resort(T, [], [DN|DNs], Tree);
+        _ ->
+            resort(T, [], DNs, Tree)
+    end;
+resort([AttrVal|T], Ls, DNs, Acc) ->
+    resort(T, [AttrVal|Ls], DNs, Acc);
+resort([], _, DNs, Tree) ->
+    {_, TopDNs} = lists:foldl(
+                    fun(D, {L, Acc}) ->
+                            NewL = length(D),
+                            if NewL < L ->
+                                    {NewL, [D]};
+                               NewL == L ->
+                                    {L, [D|Acc]};
+                               true ->
+                                    {L, Acc}
+                            end
+                    end, {unlimited, []}, DNs),
+    Attrs = lists:map(
+              fun(TopDN) ->
+                      ets:insert(Tree, {[], TopDN}),
+                      {<<"namingContexts">>, str:join(TopDN, <<",">>)}
+              end, TopDNs),
+    Attrs1 = [{<<"supportedLDAPVersion">>, <<"3">>},
+              {<<"objectClass">>, <<"top">>}|Attrs],
+    ets:insert(Tree, {{dn, []}, Attrs1}),
+    Tree.

tools/xmpp_codec.erl

@@ -4782,11 +4782,11 @@ encode_vcard_CATEGORIES(Keywords, _xmlns_attrs) ->
 					 | _acc]).
 
 decode_vcard_KEY({xmlel, <<"KEY">>, _attrs, _els}) ->
-    {Cred, Type} = decode_vcard_KEY_els(_els, [],
+    {Cred, Type} = decode_vcard_KEY_els(_els, undefined,
 					undefined),
     {vcard_key, Type, Cred}.
 
-decode_vcard_KEY_els([], [Cred], Type) -> {Cred, Type};
+decode_vcard_KEY_els([], Cred, Type) -> {Cred, Type};
 decode_vcard_KEY_els([{xmlel, <<"TYPE">>, _attrs, _} =
 			  _el
 		      | _els],
@@ -4803,11 +4803,7 @@ decode_vcard_KEY_els([{xmlel, <<"CRED">>, _attrs, _} =
 		     Cred, Type) ->
     _xmlns = xml:get_attr_s(<<"xmlns">>, _attrs),
     if _xmlns == <<>>; _xmlns == <<"vcard-temp">> ->
-	   decode_vcard_KEY_els(_els,
+	   decode_vcard_KEY_els(_els, decode_vcard_CRED(_el),
-				case decode_vcard_CRED(_el) of
-				  undefined -> Cred;
-				  _new_el -> [_new_el | Cred]
-				end,
 				Type);
        true -> decode_vcard_KEY_els(_els, Cred, Type)
     end;
@@ -4821,6 +4817,7 @@ encode_vcard_KEY({vcard_key, Type, Cred},
     _attrs = _xmlns_attrs,
     {xmlel, <<"KEY">>, _attrs, _els}.
 
+'encode_vcard_KEY_$cred'(undefined, _acc) -> _acc;
 'encode_vcard_KEY_$cred'(Cred, _acc) ->
     [encode_vcard_CRED(Cred, []) | _acc].
 
@@ -4900,10 +4897,11 @@ encode_vcard_SOUND({vcard_sound, Phonetic, Binval,
     [encode_vcard_BINVAL(Binval, []) | _acc].
 
 decode_vcard_ORG({xmlel, <<"ORG">>, _attrs, _els}) ->
-    {Units, Name} = decode_vcard_ORG_els(_els, [], []),
+    {Units, Name} = decode_vcard_ORG_els(_els, [],
+					 undefined),
     {vcard_org, Name, Units}.
 
-decode_vcard_ORG_els([], Units, [Name]) ->
+decode_vcard_ORG_els([], Units, Name) ->
     {lists:reverse(Units), Name};
 decode_vcard_ORG_els([{xmlel, <<"ORGNAME">>, _attrs,
 		       _} =
@@ -4913,10 +4911,7 @@ decode_vcard_ORG_els([{xmlel, <<"ORGNAME">>, _attrs,
     _xmlns = xml:get_attr_s(<<"xmlns">>, _attrs),
     if _xmlns == <<>>; _xmlns == <<"vcard-temp">> ->
 	   decode_vcard_ORG_els(_els, Units,
-				case decode_vcard_ORGNAME(_el) of
+				decode_vcard_ORGNAME(_el));
-				  undefined -> Name;
-				  _new_el -> [_new_el | Name]
-				end);
        true -> decode_vcard_ORG_els(_els, Units, Name)
     end;
 decode_vcard_ORG_els([{xmlel, <<"ORGUNIT">>, _attrs,
@@ -4949,6 +4944,7 @@ encode_vcard_ORG({vcard_org, Name, Units},
     'encode_vcard_ORG_$units'(_els,
 			      [encode_vcard_ORGUNIT(Units, []) | _acc]).
 
+'encode_vcard_ORG_$name'(undefined, _acc) -> _acc;
 'encode_vcard_ORG_$name'(Name, _acc) ->
     [encode_vcard_ORGNAME(Name, []) | _acc].
 
@@ -5121,22 +5117,18 @@ encode_vcard_BINVAL_cdata(_val, _acc) ->
     [{xmlcdata, base64:encode(_val)} | _acc].
 
 decode_vcard_GEO({xmlel, <<"GEO">>, _attrs, _els}) ->
-    {Lat, Lon} = decode_vcard_GEO_els(_els, [], []),
+    {Lat, Lon} = decode_vcard_GEO_els(_els, undefined,
+				      undefined),
     {vcard_geo, Lat, Lon}.
 
-decode_vcard_GEO_els([], [Lat], [Lon]) -> {Lat, Lon};
+decode_vcard_GEO_els([], Lat, Lon) -> {Lat, Lon};
 decode_vcard_GEO_els([{xmlel, <<"LAT">>, _attrs, _} =
 			  _el
 		      | _els],
 		     Lat, Lon) ->
     _xmlns = xml:get_attr_s(<<"xmlns">>, _attrs),
     if _xmlns == <<>>; _xmlns == <<"vcard-temp">> ->
-	   decode_vcard_GEO_els(_els,
+	   decode_vcard_GEO_els(_els, decode_vcard_LAT(_el), Lon);
-				case decode_vcard_LAT(_el) of
-				  undefined -> Lat;
-				  _new_el -> [_new_el | Lat]
-				end,
-				Lon);
        true -> decode_vcard_GEO_els(_els, Lat, Lon)
     end;
 decode_vcard_GEO_els([{xmlel, <<"LON">>, _attrs, _} =
@@ -5145,11 +5137,7 @@ decode_vcard_GEO_els([{xmlel, <<"LON">>, _attrs, _} =
 		     Lat, Lon) ->
     _xmlns = xml:get_attr_s(<<"xmlns">>, _attrs),
     if _xmlns == <<>>; _xmlns == <<"vcard-temp">> ->
-	   decode_vcard_GEO_els(_els, Lat,
+	   decode_vcard_GEO_els(_els, Lat, decode_vcard_LON(_el));
-				case decode_vcard_LON(_el) of
-				  undefined -> Lon;
-				  _new_el -> [_new_el | Lon]
-				end);
        true -> decode_vcard_GEO_els(_els, Lat, Lon)
     end;
 decode_vcard_GEO_els([_ | _els], Lat, Lon) ->
@@ -5161,21 +5149,23 @@ encode_vcard_GEO({vcard_geo, Lat, Lon}, _xmlns_attrs) ->
     _attrs = _xmlns_attrs,
     {xmlel, <<"GEO">>, _attrs, _els}.
 
+'encode_vcard_GEO_$lat'(undefined, _acc) -> _acc;
 'encode_vcard_GEO_$lat'(Lat, _acc) ->
     [encode_vcard_LAT(Lat, []) | _acc].
 
+'encode_vcard_GEO_$lon'(undefined, _acc) -> _acc;
 'encode_vcard_GEO_$lon'(Lon, _acc) ->
     [encode_vcard_LON(Lon, []) | _acc].
 
 decode_vcard_EMAIL({xmlel, <<"EMAIL">>, _attrs,
 		    _els}) ->
     {X400, Userid, Internet, Home, Pref, Work} =
-	decode_vcard_EMAIL_els(_els, false, [], false, false,
+	decode_vcard_EMAIL_els(_els, false, undefined, false,
-			       false, false),
+			       false, false, false),
     {vcard_email, Home, Work, Internet, Pref, X400, Userid}.
 
-decode_vcard_EMAIL_els([], X400, [Userid], Internet,
+decode_vcard_EMAIL_els([], X400, Userid, Internet, Home,
-		       Home, Pref, Work) ->
+		       Pref, Work) ->
     {X400, Userid, Internet, Home, Pref, Work};
 decode_vcard_EMAIL_els([{xmlel, <<"HOME">>, _attrs, _} =
 			    _el
@@ -5246,11 +5236,8 @@ decode_vcard_EMAIL_els([{xmlel, <<"USERID">>, _attrs,
     _xmlns = xml:get_attr_s(<<"xmlns">>, _attrs),
     if _xmlns == <<>>; _xmlns == <<"vcard-temp">> ->
 	   decode_vcard_EMAIL_els(_els, X400,
-				  case decode_vcard_USERID(_el) of
+				  decode_vcard_USERID(_el), Internet, Home,
-				    undefined -> Userid;
+				  Pref, Work);
-				    _new_el -> [_new_el | Userid]
-				  end,
-				  Internet, Home, Pref, Work);
        true ->
 	   decode_vcard_EMAIL_els(_els, X400, Userid, Internet,
 				  Home, Pref, Work)
@@ -5277,6 +5264,7 @@ encode_vcard_EMAIL({vcard_email, Home, Work, Internet,
 'encode_vcard_EMAIL_$x400'(X400, _acc) ->
     [encode_vcard_X400(X400, []) | _acc].
 
+'encode_vcard_EMAIL_$userid'(undefined, _acc) -> _acc;
 'encode_vcard_EMAIL_$userid'(Userid, _acc) ->
     [encode_vcard_USERID(Userid, []) | _acc].
 
@@ -5299,15 +5287,14 @@ encode_vcard_EMAIL({vcard_email, Home, Work, Internet,
 decode_vcard_TEL({xmlel, <<"TEL">>, _attrs, _els}) ->
     {Number, Pager, Pcs, Bbs, Voice, Home, Pref, Msg, Fax,
      Work, Cell, Modem, Isdn, Video} =
-	decode_vcard_TEL_els(_els, [], false, false, false,
+	decode_vcard_TEL_els(_els, undefined, false, false,
 			     false, false, false, false, false, false, false,
-			     false, false, false),
+			     false, false, false, false),
     {vcard_tel, Home, Work, Voice, Fax, Pager, Msg, Cell,
      Video, Bbs, Modem, Isdn, Pcs, Pref, Number}.
 
-decode_vcard_TEL_els([], [Number], Pager, Pcs, Bbs,
+decode_vcard_TEL_els([], Number, Pager, Pcs, Bbs, Voice,
-		     Voice, Home, Pref, Msg, Fax, Work, Cell, Modem, Isdn,
+		     Home, Pref, Msg, Fax, Work, Cell, Modem, Isdn, Video) ->
-		     Video) ->
     {Number, Pager, Pcs, Bbs, Voice, Home, Pref, Msg, Fax,
      Work, Cell, Modem, Isdn, Video};
 decode_vcard_TEL_els([{xmlel, <<"HOME">>, _attrs, _} =
@@ -5513,11 +5500,7 @@ decode_vcard_TEL_els([{xmlel, <<"NUMBER">>, _attrs, _} =
 		     Work, Cell, Modem, Isdn, Video) ->
     _xmlns = xml:get_attr_s(<<"xmlns">>, _attrs),
     if _xmlns == <<>>; _xmlns == <<"vcard-temp">> ->
-	   decode_vcard_TEL_els(_els,
+	   decode_vcard_TEL_els(_els, decode_vcard_NUMBER(_el),
-				case decode_vcard_NUMBER(_el) of
-				  undefined -> Number;
-				  _new_el -> [_new_el | Number]
-				end,
 				Pager, Pcs, Bbs, Voice, Home, Pref, Msg, Fax,
 				Work, Cell, Modem, Isdn, Video);
        true ->
@@ -5554,6 +5537,7 @@ encode_vcard_TEL({vcard_tel, Home, Work, Voice, Fax,
     _attrs = _xmlns_attrs,
     {xmlel, <<"TEL">>, _attrs, _els}.
 
+'encode_vcard_TEL_$number'(undefined, _acc) -> _acc;
 'encode_vcard_TEL_$number'(Number, _acc) ->
     [encode_vcard_NUMBER(Number, []) | _acc].
 

tools/xmpp_codec.spec

@@ -1343,7 +1343,7 @@
                #ref{name = vcard_PREF, default = false,
                     min = 0, max = 1, label = '$pref'},
                #ref{name = vcard_NUMBER,
-                    min = 1, max = 1, label = '$number'}]}}.
+                    min = 0, max = 1, label = '$number'}]}}.
 
 {vcard_EMAIL,
  #elem{name = <<"EMAIL">>,
@@ -1361,14 +1361,14 @@
                #ref{name = vcard_X400, default = false,
                     min = 0, max = 1, label = '$x400'},
                #ref{name = vcard_USERID,
-                    min = 1, max = 1, label = '$userid'}]}}.
+                    min = 0, max = 1, label = '$userid'}]}}.
 
 {vcard_GEO,
  #elem{name = <<"GEO">>,
        xmlns = <<"vcard-temp">>,
        result = {vcard_geo, '$lat', '$lon'},
-       refs = [#ref{name = vcard_LAT, min = 1, max = 1, label = '$lat'},
+       refs = [#ref{name = vcard_LAT, min = 0, max = 1, label = '$lat'},
-               #ref{name = vcard_LON, min = 1, max = 1, label = '$lon'}]}}.
+               #ref{name = vcard_LON, min = 0, max = 1, label = '$lon'}]}}.
 
 {vcard_BINVAL,
  #elem{name = <<"BINVAL">>,
@@ -1399,7 +1399,7 @@
        result = {vcard_org, '$name', '$units'},
        refs = [#ref{name = vcard_ORGNAME,
                     label = '$name',
-                    min = 1, max = 1},
+                    min = 0, max = 1},
                #ref{name = vcard_ORGUNIT,
                     label = '$units'}]}}.
 
@@ -1416,7 +1416,7 @@
        xmlns = <<"vcard-temp">>,
        result = {vcard_key, '$type', '$cred'},
        refs = [#ref{name = vcard_TYPE, min = 0, max = 1, label = '$type'},
-               #ref{name = vcard_CRED, min = 1, max = 1, label = '$cred'}]}}.
+               #ref{name = vcard_CRED, min = 0, max = 1, label = '$cred'}]}}.
 
 {vcard_CATEGORIES,
  #elem{name = <<"CATEGORIES">>,