<commit_before>%%%-------------------------------------------------------------------
%%%
%%% Copyright (C) 2002-2018 ProcessOne, SARL. All Rights Reserved.
%%%
%%% Licensed under the Apache License, Version 2.0 (the "License");
%%% you may not use this file except in compliance with the License.
%%% You may obtain a copy of the License at
%%%
%%%     http://www.apache.org/licenses/LICENSE-2.0
%%%
%%% Unless required by applicable law or agreed to in writing, software
%%% distributed under the License is distributed on an "AS IS" BASIS,
%%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
%%% See the License for the specific language governing permissions and
%%% limitations under the License.
%%%
%%%-------------------------------------------------------------------
-module(xmpp_stream_pkix).

%% API
-export([authenticate/1, authenticate/2, get_cert_domains/1, format_error/1]).

-include("xmpp.hrl").
-include_lib("public_key/include/public_key.hrl").
-include("XmppAddr.hrl").

-type cert() :: #'OTPCertificate'{}.

%%%===================================================================
%%% 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,
	       socket := Socket} = State, Authzid) ->
    Peer = maps:get(remote_server, State, Authzid),
    case verify_cert(Socket) of
	{ok, Cert} ->
	    case xmpp_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;
	{error, Reason} ->
	    {error, Reason, Peer}
    end;
authenticate(#{xmlns := ?NS_CLIENT,
	       socket := Socket, server := Server}, Authzid) ->
    JID = try jid:decode(Authzid)
	  catch _:{bad_jid, <<>>} -> jid:make(Server);
		_:{bad_jid, _} -> {error, invalid_authzid, Authzid}
	  end,
    case JID of
	#jid{user = User, lserver = LServer} ->
	    case verify_cert(Socket) of
		{ok, Cert} ->
		    JIDs = get_xmpp_addrs(Cert),
		    get_username(JID, JIDs, LServer);
		{error, Reason} ->
		    {error, Reason, User}
	    end;
	Err ->
	    Err
    end.

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(jid_mismatch) ->
    {'not-authorized', <<"Certificate JID mismatch">>};
format_error(get_cert_failed) ->
    {'bad-protocol', <<"Failed to get peer certificate">>};
format_error(invalid_authzid) ->
    {'invalid-authzid', <<"Malformed JID">>};
format_error(Other) ->
    {'not-authorized', erlang:atom_to_binary(Other, utf8)}.

-spec get_cert_domains(cert()) -> [binary()].
get_cert_domains(Cert) ->
    TBSCert = Cert#'OTPCertificate'.tbsCertificate,
    {rdnSequence, Subject} = TBSCert#'OTPTBSCertificate'.subject,
    Extensions = TBSCert#'OTPTBSCertificate'.extensions,
    get_domain_from_subject(lists:flatten(Subject)) ++
	get_domains_from_san(Extensions).

%%%===================================================================
%%% Internal functions
%%%===================================================================
-spec verify_cert(xmpp_socket:socket()) -> {ok, cert()} | {error, atom()}.
verify_cert(Socket) ->
    case xmpp_socket:get_peer_certificate(Socket, otp) of
	{ok, Cert} ->
	    case xmpp_socket:get_verify_result(Socket) of
		0 ->
		    {ok, Cert};
		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)}
	    end;
	error ->
	    {error, get_cert_failed}
    end.

-spec get_domain_from_subject([#'AttributeTypeAndValue'{}]) -> [binary()].
get_domain_from_subject(AttrVals) ->
    case lists:keyfind(?'id-at-commonName',
		       #'AttributeTypeAndValue'.type,
		       AttrVals) of
	#'AttributeTypeAndValue'{value = {_, S}} ->
	    try jid:decode(iolist_to_binary(S)) of
		#jid{luser = <<"">>, lresource = <<"">>, lserver = Domain} ->
		    [Domain];
		_ ->
		    []
	    catch _:{bad_jid, _} -><commit_msg>Fix PKIX authentication for outgoing c2s<commit_after>%%%-------------------------------------------------------------------
%%%
%%% Copyright (C) 2002-2018 ProcessOne, SARL. All Rights Reserved.
%%%
%%% Licensed under the Apache License, Version 2.0 (the "License");
%%% you may not use this file except in compliance with the License.
%%% You may obtain a copy of the License at
%%%
%%%     http://www.apache.org/licenses/LICENSE-2.0
%%%
%%% Unless required by applicable law or agreed to in writing, software
%%% distributed under the License is distributed on an "AS IS" BASIS,
%%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
%%% See the License for the specific language governing permissions and
%%% limitations under the License.
%%%
%%%-------------------------------------------------------------------
-module(xmpp_stream_pkix).

%% API
-export([authenticate/1, authenticate/2, get_cert_domains/1, format_error/1]).

-include("xmpp.hrl").
-include_lib("public_key/include/public_key.hrl").
-include("XmppAddr.hrl").

-type cert() :: #'OTPCertificate'{}.

%%%===================================================================
%%% 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,
	       socket := Socket} = State, Authzid) ->
    Peer = maps:get(remote_server, State, Authzid),
    case verify_server_cert(Peer, Socket) of
	ok ->
	    {ok, Peer};
	{error, Reason} ->
	    {error, Reason, Peer}
    end;
authenticate(#{xmlns := ?NS_CLIENT, stream_direction := out,
	       socket := Socket, server := Server}, _) ->
    case verify_server_cert(Server, Socket) of
	ok ->
	    {ok, Server};
	{error, Reason} ->
	    {error, Reason, Server}
    end;
authenticate(#{xmlns := ?NS_CLIENT, stream_direction := in,
	       socket := Socket, server := Server}, Authzid) ->
    JID = try jid:decode(Authzid)
	  catch _:{bad_jid, <<>>} -> jid:make(Server);
		_:{bad_jid, _} -> {error, invalid_authzid, Authzid}
	  end,
    case JID of
	#jid{user = User, lserver = LServer} ->
	    case verify_cert(Socket) of
		{ok, Cert} ->
		    JIDs = get_xmpp_addrs(Cert),
		    get_username(JID, JIDs, LServer);
		{error, Reason} ->
		    {error, Reason, User}
	    end;
	Err ->
	    Err
    end.

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(jid_mismatch) ->
    {'not-authorized', <<"Certificate JID mismatch">>};
format_error(get_cert_failed) ->
    {'bad-protocol', <<"Failed to get peer certificate">>};
format_error(invalid_authzid) ->
    {'invalid-authzid', <<"Malformed JID">>};
format_error(Other) ->
    {'not-authorized', erlang:atom_to_binary(Other, utf8)}.

-spec get_cert_domains(cert()) -> [binary()].
get_cert_domains(Cert) ->
    TBSCert = Cert#'OTPCertificate'.tbsCertificate,
    {rdnSequence, Subject} = TBSCert#'OTPTBSCertificate'.subject,
    Extensions = TBSCert#'OTPTBSCertificate'.extensions,
    get_domain_from_subject(lists:flatten(Subject)) ++
	get_domains_from_san(Extensions).

%%%===================================================================
%%% Internal functions
%%%===================================================================
-spec verify_server_cert(binary(), xmpp_socket:socket()) -> ok | {error, atom()}.
verify_server_cert(Server, Socket) ->
    case verify_cert(Socket) of
	{ok, Cert} ->
	    case xmpp_idna:domain_utf8_to_ascii(Server) of
		false ->
		    {error, idna_failed};
		AsciiServer ->
		    case lists:any(
			   fun(D) -> match_domain(AsciiServer, D) end,
			   get_cert_domains(Cert)) of
			true ->
			    ok;
			false ->
			    {error, hostname_mismatch}
		    end
	    end;
	{error, _} = Err ->
	    Err
    end.

-spec verify_cert(xmpp_socket:socket()) -> {ok, cert()} | {error, atom()}.
verify_cert(Socket) ->
    case xmpp_socket:get_peer_certificate(Socket, otp) of
	{ok, Cert} ->
	    case xmpp_socket:get_verify_result(Socket) of
		0 ->
		    {ok, Cert};
		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)}
	    end;
	error ->
	    {error, get_cert_failed}
    end.

-spec get_domain_from_subject([#'AttributeTypeAndValue'{}]) -> [binary()].
get_domain_from_subject(AttrVals) ->
    case lists:keyfind(?'id-at-commonName',
		       #'AttributeTypeAndValue'.type,
		       AttrVals) of
	#'AttributeTypeAndValue'{value = {_, S}} ->
	    try jid:decode(iolist_to_binary(S)) of
		#jid{luser = <<"">>, lresource = <<"">>, lserver = Domain} ->
		    [Domain];
		_ ->
		    []
	    catch _:{bad_jid, _} ->
{'fraction_non_alphanumeric': 0.23370972754584068, 'fraction_numerical': 0.00424738423288097, 'mean_word_length': 3.601525262154433, 'pattern_counts': {'":': 0, '<': 39, '<?xml version=': 0, '>': 122, 'https://': 0, 'lorem ipsum': 0, 'www.': 2, 'xml': 5}, 'pii_count': 0, 'substrings_counts': 0, 'word_list_counts': {'cursed_substrings.json': 0, 'profanity_word_list.json': 0, 'sexual_word_list.json': 0, 'zh_pornsignals.json': 0}}
{'dir': 'git-commits-cleaned', 'id': '324043', 'n_tokens_mistral': 3370, 'n_tokens_neox': 3103, 'n_words': 686}