diff options
Diffstat (limited to 'src/xmpp_stream_pkix.erl')
| -rw-r--r-- | src/xmpp_stream_pkix.erl | 176 |
1 files changed, 176 insertions, 0 deletions
diff --git a/src/xmpp_stream_pkix.erl b/src/xmpp_stream_pkix.erl new file mode 100644 index 000000000..5d64c5eb6 --- /dev/null +++ b/src/xmpp_stream_pkix.erl @@ -0,0 +1,176 @@ +%%%------------------------------------------------------------------- +%%% @author Evgeny Khramtsov <ekhramtsov@process-one.net> +%%% @copyright (C) 2016, Evgeny Khramtsov +%%% @doc +%%% +%%% @end +%%% Created : 13 Dec 2016 by Evgeny Khramtsov <ekhramtsov@process-one.net> +%%%------------------------------------------------------------------- +-module(xmpp_stream_pkix). + +%% API +-export([authenticate/1, authenticate/2, format_error/1]). + +-include("xmpp.hrl"). +-include_lib("public_key/include/public_key.hrl"). +-include("XmppAddr.hrl"). + +%%%=================================================================== +%%% API +%%%=================================================================== +-spec authenticate(xmpp_stream_in:state() | xmpp_stream_out:state()) + -> {ok, binary()} | {error, atom(), binary()}. +authenticate(State) -> + authenticate(State, <<"">>). + +-spec authenticate(xmpp_stream_in:state() | xmpp_stream_out:state(), binary()) + -> {ok, binary()} | {error, atom(), binary()}. +authenticate(#{xmlns := ?NS_SERVER, sockmod := SockMod, + socket := Socket} = State, Authzid) -> + Peer = try maps:get(remote_server, State) + catch _:{badkey, _} -> Authzid + end, + case SockMod:get_peer_certificate(Socket) of + {ok, Cert} -> + case SockMod:get_verify_result(Socket) of + 0 -> + case ejabberd_idna:domain_utf8_to_ascii(Peer) of + false -> + {error, idna_failed, Peer}; + AsciiPeer -> + case lists:any( + fun(D) -> match_domain(AsciiPeer, D) end, + get_cert_domains(Cert)) of + true -> + {ok, Peer}; + false -> + {error, hostname_mismatch, Peer} + end + end; + VerifyRes -> + %% TODO: return atomic errors + %% This should be improved in fast_tls + Reason = fast_tls:get_cert_verify_string(VerifyRes, Cert), + {error, erlang:binary_to_atom(Reason, utf8), Peer} + end; + {error, _Reason} -> + {error, get_cert_failed, Peer}; + error -> + {error, get_cert_failed, Peer} + end; +authenticate(_State, _Authzid) -> + %% TODO: client PKIX authentication + {error, client_not_supported, <<"">>}. + +format_error(idna_failed) -> + {'bad-protocol', <<"Remote domain is not an IDN hostname">>}; +format_error(hostname_mismatch) -> + {'not-authorized', <<"Certificate host name mismatch">>}; +format_error(get_cert_failed) -> + {'bad-protocol', <<"Failed to get peer certificate">>}; +format_error(client_not_supported) -> + {'invalid-mechanism', <<"Client certificate verification is not supported">>}; +format_error(Other) -> + {'not-authorized', erlang:atom_to_binary(Other, utf8)}. + +%%%=================================================================== +%%% Internal functions +%%%=================================================================== +get_cert_domains(Cert) -> + TBSCert = Cert#'Certificate'.tbsCertificate, + Subject = case TBSCert#'TBSCertificate'.subject of + {rdnSequence, Subj} -> lists:flatten(Subj); + _ -> [] + end, + Extensions = case TBSCert#'TBSCertificate'.extensions of + Exts when is_list(Exts) -> Exts; + _ -> [] + end, + lists:flatmap( + fun(#'AttributeTypeAndValue'{type = ?'id-at-commonName',value = Val}) -> + case 'OTP-PUB-KEY':decode('X520CommonName', Val) of + {ok, {_, D1}} -> + D = if is_binary(D1) -> D1; + is_list(D1) -> list_to_binary(D1); + true -> error + end, + if D /= error -> + case jid:from_string(D) of + #jid{luser = <<"">>, lserver = LD, + lresource = <<"">>} -> + [LD]; + _ -> [] + end; + true -> [] + end; + _ -> [] + end; + (_) -> [] + end, Subject) ++ + lists:flatmap( + fun(#'Extension'{extnID = ?'id-ce-subjectAltName', + extnValue = Val}) -> + BVal = if is_list(Val) -> list_to_binary(Val); + true -> Val + end, + case 'OTP-PUB-KEY':decode('SubjectAltName', BVal) of + {ok, SANs} -> + lists:flatmap( + fun({otherName, #'AnotherName'{'type-id' = ?'id-on-xmppAddr', + value = XmppAddr}}) -> + case 'XmppAddr':decode('XmppAddr', XmppAddr) of + {ok, D} when is_binary(D) -> + case jid:from_string(D) of + #jid{luser = <<"">>, + lserver = LD, + lresource = <<"">>} -> + case ejabberd_idna:domain_utf8_to_ascii(LD) of + false -> + []; + PCLD -> + [PCLD] + end; + _ -> [] + end; + _ -> [] + end; + ({dNSName, D}) when is_list(D) -> + case jid:from_string(list_to_binary(D)) of + #jid{luser = <<"">>, + lserver = LD, + lresource = <<"">>} -> + [LD]; + _ -> [] + end; + (_) -> [] + end, SANs); + _ -> [] + end; + (_) -> [] + end, Extensions). + +match_domain(Domain, Domain) -> true; +match_domain(Domain, Pattern) -> + DLabels = str:tokens(Domain, <<".">>), + PLabels = str:tokens(Pattern, <<".">>), + match_labels(DLabels, PLabels). + +match_labels([], []) -> true; +match_labels([], [_ | _]) -> false; +match_labels([_ | _], []) -> false; +match_labels([DL | DLabels], [PL | PLabels]) -> + case lists:all(fun (C) -> + $a =< C andalso C =< $z orelse + $0 =< C andalso C =< $9 orelse + C == $- orelse C == $* + end, + binary_to_list(PL)) + of + true -> + Regexp = ejabberd_regexp:sh_to_awk(PL), + case ejabberd_regexp:run(DL, Regexp) of + match -> match_labels(DLabels, PLabels); + nomatch -> false + end; + false -> false + end. |