xmpp.chapril.org-ejabberd/src/ejabberd_acme.erl

-module (ejabberd_acme).
-behaviour(gen_server).
-behaviour(ejabberd_config).

%% ejabberdctl commands
-export([get_certificates/1,
	 renew_certificates/0,
	 list_certificates/1,
	 revoke_certificate/1]).
%% Command Options Validity
-export([is_valid_account_opt/1,
	 is_valid_verbose_opt/1,
	 is_valid_domain_opt/1,
	 is_valid_revoke_cert/1]).
%% Key Related
-export([generate_key/0, to_public/1]).
%% gen_server callbacks
-export([init/1, handle_call/3, handle_cast/2, handle_info/2,
	 terminate/2, code_change/3]).
-export([start_link/0, opt_type/1, register_certfiles/0]).

-include("ejabberd.hrl").
-include("logger.hrl").
-include("xmpp.hrl").
-include("ejabberd_commands.hrl").
-include("ejabberd_acme.hrl").
-include_lib("public_key/include/public_key.hrl").

-define(DEFAULT_CONFIG_CONTACT, <<"mailto:example-admin@example.com">>).
-define(DEFAULT_CONFIG_CA_URL, "https://acme-v01.api.letsencrypt.org").

-record(state, {}).

start_link() ->
    gen_server:start_link({local, ?MODULE}, ?MODULE, [], []).

%%%===================================================================
%%% gen_server callbacks
%%%===================================================================
init([]) ->
    case filelib:ensure_dir(filename:join(acme_certs_dir(), "foo")) of
	ok ->
	    ejabberd_hooks:add(config_reloaded, ?MODULE, register_certfiles, 40),
	    ejabberd_commands:register_commands(get_commands_spec()),
	    register_certfiles(),
	    {ok, #state{}};
	{error, Why} ->
	    ?CRITICAL_MSG("Failed to create directory ~s: ~s",
			  [acme_certs_dir(), file:format_error(Why)]),
	    {stop, Why}
    end.

handle_call(_Request, _From, State) ->
    {stop, {unexpected_call, _Request, _From}, State}.

handle_cast(_Msg, State) ->
    ?WARNING_MSG("unexpected cast: ~p", [_Msg]),
    {noreply, State}.

handle_info(_Info, State) ->
    ?WARNING_MSG("unexpected info: ~p", [_Info]),
    {noreply, State}.

terminate(_Reason, _State) ->
    ejabberd_hooks:delete(config_reloaded, ?MODULE, register_certfiles, 40),
    ejabberd_commands:unregister_commands(get_commands_spec()).

code_change(_OldVsn, State, _Extra) ->
    {ok, State}.

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%%
%% Command Functions
%%
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%

%%
%% Check Validity of command options
%%

-spec is_valid_account_opt(string()) -> boolean().
is_valid_account_opt("old-account") -> true;
is_valid_account_opt("new-account") -> true;
is_valid_account_opt(_) -> false.

-spec is_valid_verbose_opt(string()) -> boolean().
is_valid_verbose_opt("plain") -> true;
is_valid_verbose_opt("verbose") -> true;
is_valid_verbose_opt(_) -> false.

%% TODO: Make this check more complicated
-spec is_valid_domain_opt(string()) -> boolean().
is_valid_domain_opt("all") -> true;
is_valid_domain_opt(DomainString) ->
    case parse_domain_string(DomainString) of
	[] ->
	    false;
	_SeparatedDomains ->
	    true
    end.

-spec is_valid_revoke_cert(string()) -> boolean().
is_valid_revoke_cert(DomainOrFile) ->	    
    lists:prefix("file:", DomainOrFile) orelse
	lists:prefix("domain:", DomainOrFile).
	    
%% Commands
get_commands_spec() ->
    [#ejabberd_commands{name = get_certificates, tags = [acme],
			desc = "Gets certificates for all or the specified "
			       "domains {all|domain1;domain2;...}.",
			module = ?MODULE, function = get_certificates,
			args_desc = ["Domains for which to acquire a certificate"],
			args_example = ["all | www.example.com;www.example1.net"],
			args = [{domains, string}],
			result = {certificates, string}},
     #ejabberd_commands{name = renew_certificates, tags = [acme],
			desc = "Renews all certificates that are close to expiring",
			module = ?MODULE, function = renew_certificates,
			args = [],
			result = {certificates, string}},
     #ejabberd_commands{name = list_certificates, tags = [acme],
			desc = "Lists all curently handled certificates and "
			       "their respective domains in {plain|verbose} format",
			module = ?MODULE, function = list_certificates,
			args_desc = ["Whether to print the whole certificate "
				     "or just some metadata. "
				     "Possible values: plain | verbose"],
			args = [{option, string}],
			result = {certificates, {list, {certificate, string}}}},
     #ejabberd_commands{name = revoke_certificate, tags = [acme],
			desc = "Revokes the selected certificate",
			module = ?MODULE, function = revoke_certificate,
			args_desc = ["The domain or file (in pem format) of "
				     "the certificate in question "
				     "{domain:Domain | file:File}"],
			args = [{domain_or_file, string}],
			result = {res, restuple}}].

%%
%% Get Certificate
%%
-spec get_certificates(domains_opt()) -> string() | {'error', _}.
get_certificates(Domains) ->
    case is_valid_domain_opt(Domains) of 
	true ->
	    try
		CAUrl = get_config_ca_url(),
		get_certificates0(CAUrl, Domains)
	    catch
		throw:Throw ->
		    Throw;
		E:R ->
		    ?ERROR_MSG("Unknown ~p:~p, ~p", [E, R, erlang:get_stacktrace()]), 
		    {error, get_certificates}
	    end;
	false ->
	    io_lib:format("Invalid domains: ~p", [Domains])
    end.

-spec get_certificates0(url(), domains_opt()) -> string().
get_certificates0(CAUrl, Domains) ->
    %% Check if an account exists or create another one
    {ok, _AccId, PrivateKey} = retrieve_or_create_account(CAUrl),

    get_certificates1(CAUrl, Domains, PrivateKey).

-spec retrieve_or_create_account(url()) -> {'ok', string(), jose_jwk:key()}.
retrieve_or_create_account(CAUrl) ->
    case read_account_persistent() of
	none ->
	    create_save_new_account(CAUrl);
	
	{ok, AccId, CAUrl, PrivateKey} ->
	    {ok, AccId, PrivateKey};
	{ok, _AccId, _, _PrivateKey} ->
	    create_save_new_account(CAUrl)
    end.


-spec get_certificates1(url(), domains_opt(), jose_jwk:key()) -> string().
get_certificates1(CAUrl, "all", PrivateKey) ->
    Hosts = get_config_hosts(),
    get_certificates2(CAUrl, PrivateKey, Hosts);
get_certificates1(CAUrl, DomainString, PrivateKey) ->
    Domains = parse_domain_string(DomainString),
    Hosts = [list_to_bitstring(D) || D <- Domains],
    get_certificates2(CAUrl, PrivateKey, Hosts).

-spec get_certificates2(url(), jose_jwk:key(), [bitstring()]) -> string().
get_certificates2(CAUrl, PrivateKey, Hosts) ->
    %% Get a certificate for each host
    PemCertKeys = [get_certificate(CAUrl, Host, PrivateKey) || Host <- Hosts],

    %% Save Certificates
    SavedCerts = [save_certificate(Cert) || Cert <- PemCertKeys],

    %% Format the result to send back to ejabberdctl
    format_get_certificates_result(SavedCerts).

-spec format_get_certificates_result([{'ok', bitstring(), _} | 
				      {'error', bitstring(), _}]) ->
					    string().
format_get_certificates_result(Certs) ->
    Cond = lists:all(fun(Cert) ->
			     not is_error(Cert)
		     end, Certs),
    %% FormattedCerts = string:join([format_get_certificate(C) || C <- Certs], "\n"),
    FormattedCerts = str:join([format_get_certificate(C) || C <- Certs], $\n),
    case Cond of
	true ->
	    Result = io_lib:format("Success:~n~s", [FormattedCerts]),
	    lists:flatten(Result); 
	_ ->
	    Result = io_lib:format("Error with one or more certificates~n~s", [FormattedCerts]),
	    lists:flatten(Result)
    end.

-spec format_get_certificate({'ok', bitstring(), _} | 
			     {'error', bitstring(), _}) ->
				    string().
format_get_certificate({ok, Domain, saved}) ->    
    io_lib:format("  Certificate for domain: \"~s\" acquired and saved", [Domain]);
format_get_certificate({ok, Domain, not_found}) ->    
    io_lib:format("  Certificate for domain: \"~s\" not found, so it was not renewed", [Domain]);
format_get_certificate({ok, Domain, no_expire}) ->
    io_lib:format("  Certificate for domain: \"~s\" is not close to expiring", [Domain]);
format_get_certificate({error, Domain, Reason}) ->
    io_lib:format("  Error for domain: \"~s\",  with reason: \'~s\'", [Domain, Reason]).

-spec get_certificate(url(), bitstring(), jose_jwk:key()) -> 
			     {'ok', bitstring(), pem()} | 
			     {'error', bitstring(), _}.
get_certificate(CAUrl, DomainName, PrivateKey) ->
    try
	AllSubDomains = find_all_sub_domains(DomainName),
	lists:foreach(
	  fun(Domain) ->
		  {ok, _Authz} = create_new_authorization(CAUrl, Domain, PrivateKey)
	  end, [DomainName|AllSubDomains]),
	create_new_certificate(CAUrl, {DomainName, AllSubDomains}, PrivateKey)
    catch
	throw:Throw ->
	    Throw;
	E:R ->
	    ?ERROR_MSG("Unknown ~p:~p, ~p", [E, R, erlang:get_stacktrace()]), 
	    {error, DomainName, get_certificate}
    end.

-spec create_save_new_account(url()) -> {'ok', string(), jose_jwk:key()} | no_return().
create_save_new_account(CAUrl) ->
    %% Get contact from configuration file
    Contact = get_config_contact(),

    %% Generate a Key
    PrivateKey = generate_key(),

    %% Create a new account
    {ok, Id} = create_new_account(CAUrl, Contact, PrivateKey),

    %% Write Persistent Data
    ok = write_account_persistent({Id, CAUrl, PrivateKey}),

    {ok, Id, PrivateKey}.

%% TODO:
%% Find a way to ask the user if he accepts the TOS
-spec create_new_account(url(), bitstring(), jose_jwk:key()) -> {'ok', string()} | 
								no_return().
create_new_account(CAUrl, Contact, PrivateKey) ->
    try
	{ok, Dirs, Nonce0} = ejabberd_acme_comm:directory(CAUrl),
	Req0 = [{ <<"contact">>, [Contact]}],
	{ok, {TOS, Account}, Nonce1} = 
	    ejabberd_acme_comm:new_account(Dirs, PrivateKey, Req0, Nonce0),
	{<<"id">>, AccIdInt} = lists:keyfind(<<"id">>, 1, Account),
	AccId = integer_to_list(AccIdInt),
	Req1 = [{ <<"agreement">>, list_to_bitstring(TOS)}],
	{ok, _Account2, _Nonce2} = 
	    ejabberd_acme_comm:update_account({CAUrl, AccId}, PrivateKey, Req1, Nonce1),
	{ok, AccId}
    catch
	E:R ->
	    ?ERROR_MSG("Error: ~p creating an account for contact: ~p", 
		       [{E,R}, Contact]),
	    throw({error,create_new_account})
    end.

-spec create_new_authorization(url(), bitstring(), jose_jwk:key()) ->
				      {'ok', proplist()} | no_return().
create_new_authorization(CAUrl, DomainName, PrivateKey) ->
    acme_challenge:register_hooks(DomainName),
    try
	{ok, Dirs, Nonce0} = ejabberd_acme_comm:directory(CAUrl),
	Req0 = [{<<"identifier">>,
		 {[{<<"type">>, <<"dns">>},
		   {<<"value">>, DomainName}]}},
		{<<"existing">>, <<"accept">>}],
	{ok, {AuthzUrl, Authz}, Nonce1} = 
	    ejabberd_acme_comm:new_authz(Dirs, PrivateKey, Req0, Nonce0),
	{ok, AuthzId} = location_to_id(AuthzUrl),

	Challenges = get_challenges(Authz),
	{ok, ChallengeUrl, KeyAuthz} =
	    acme_challenge:solve_challenge(<<"http-01">>, Challenges, PrivateKey),
	{ok, ChallengeId} = location_to_id(ChallengeUrl),
	Req3 = [{<<"type">>, <<"http-01">>},{<<"keyAuthorization">>, KeyAuthz}],
	{ok, _SolvedChallenge, _Nonce2} = ejabberd_acme_comm:complete_challenge(
					    {CAUrl, AuthzId, ChallengeId}, PrivateKey, Req3, Nonce1),

	{ok, AuthzValid, _Nonce} = ejabberd_acme_comm:get_authz_until_valid({CAUrl, AuthzId}),
	{ok, AuthzValid}
    catch
	E:R ->
	    ?ERROR_MSG("Error: ~p getting an authorization for domain: ~p~n",
		       [{E,R}, DomainName]),
	    throw({error, DomainName, authorization})
    after
	acme_challenge:unregister_hooks(DomainName)
    end.

-spec create_new_certificate(url(), {bitstring(), [bitstring()]}, jose_jwk:key()) -> 
				    {ok, bitstring(), pem()}.
create_new_certificate(CAUrl, {DomainName, AllSubDomains}, PrivateKey) ->
    try
	{ok, Dirs, Nonce0} = ejabberd_acme_comm:directory(CAUrl),
	CSRSubject = [{commonName, bitstring_to_list(DomainName)}],
	SANs = [{dNSName, SAN} || SAN <- AllSubDomains],
	{CSR, CSRKey} = make_csr(CSRSubject, SANs),
	{NotBefore, NotAfter} = not_before_not_after(),
	Req =
	    [{<<"csr">>, CSR},
	     {<<"notBefore">>, NotBefore},
	     {<<"NotAfter">>, NotAfter}
	    ],
	{ok, {IssuerCertLink, Certificate}, _Nonce1} =
	    ejabberd_acme_comm:new_cert(Dirs, PrivateKey, Req, Nonce0),

	DecodedCert = public_key:pkix_decode_cert(list_to_binary(Certificate), plain),	
	PemEntryCert = public_key:pem_entry_encode('Certificate', DecodedCert),

	{ok, IssuerCert, _Nonce2} = ejabberd_acme_comm:get_issuer_cert(IssuerCertLink),
	DecodedIssuerCert = public_key:pkix_decode_cert(list_to_binary(IssuerCert), plain),
	PemEntryIssuerCert = public_key:pem_entry_encode('Certificate', DecodedIssuerCert),

	{_, CSRKeyKey} = jose_jwk:to_key(CSRKey),
	PemEntryKey = public_key:pem_entry_encode('ECPrivateKey', CSRKeyKey),

	PemCertKey = public_key:pem_encode([PemEntryKey, PemEntryCert, PemEntryIssuerCert]),

	{ok, DomainName, PemCertKey}
    catch		     
	E:R ->
	    ?ERROR_MSG("Error: ~p getting an authorization for domain: ~p~n",
		       [{E,R}, DomainName]),
	    throw({error, DomainName, certificate})
    end.

-spec ensure_account_exists(url()) -> {ok, string(), jose_jwk:key()}.
ensure_account_exists(CAUrl) ->
    case read_account_persistent() of
	none ->
	    ?ERROR_MSG("No existing account", []),
	    throw({error, no_old_account});
	{ok, AccId, CAUrl, PrivateKey} ->
	    {ok, AccId, PrivateKey};
	{ok, _AccId, OtherCAUrl, _PrivateKey} ->
	    ?ERROR_MSG("Account is connected to another CA: ~s", [OtherCAUrl]),
	    throw({error, account_in_other_CA})
    end.


%%
%% Renew Certificates
%%
-spec renew_certificates() -> string() | {'error', _}.
renew_certificates() ->
    try
	CAUrl = get_config_ca_url(),
        renew_certificates0(CAUrl)
    catch
	throw:Throw ->
	    Throw;
	E:R ->
	    ?ERROR_MSG("Unknown ~p:~p, ~p", [E, R, erlang:get_stacktrace()]), 
	    {error, get_certificates}
    end.

-spec renew_certificates0(url()) -> string().
renew_certificates0(CAUrl) ->
    %% Get the current account
    {ok, _AccId, PrivateKey} = ensure_account_exists(CAUrl),

    %% Find all hosts that we have certificates for
    Certs = read_certificates_persistent(),

    %% Get a certificate for each host
    PemCertKeys = [renew_certificate(CAUrl, Cert, PrivateKey) || Cert <- Certs],

    %% Save Certificates
    SavedCerts = [save_renewed_certificate(Cert) || Cert <- PemCertKeys],

    %% Format the result to send back to ejabberdctl
    format_get_certificates_result(SavedCerts).

-spec renew_certificate(url(), {bitstring(), data_cert()}, jose_jwk:key()) -> 
			       {'ok', bitstring(), _} | 
			       {'error', bitstring(), _}.
renew_certificate(CAUrl, {DomainName, _} = Cert, PrivateKey) ->
    case cert_to_expire(Cert) of
	true ->
	    get_certificate(CAUrl, DomainName, PrivateKey);
	false ->
	    {ok, DomainName, no_expire}
    end.


-spec cert_to_expire({bitstring(), data_cert()}) -> boolean().
cert_to_expire({_DomainName, #data_cert{pem = Pem}}) ->
    Certificate = pem_to_certificate(Pem),
    Validity = get_utc_validity(Certificate),

    %% 30 days before expiration
    close_to_expire(Validity, 30).

-spec close_to_expire(string(), integer()) -> boolean().
close_to_expire(Validity, Days) ->
    {ValidDate, _ValidTime} = utc_string_to_datetime(Validity),
    ValidDays = calendar:date_to_gregorian_days(ValidDate),

    {CurrentDate, _CurrentTime} = calendar:universal_time(),
    CurrentDays = calendar:date_to_gregorian_days(CurrentDate),
    CurrentDays > ValidDays - Days.



%%
%% List Certificates
%%
-spec list_certificates(verbose_opt()) -> [string()] | [any()] | {error, _}.
list_certificates(Verbose) ->
    case is_valid_verbose_opt(Verbose) of
	true ->
	    try
		list_certificates0(Verbose)
	    catch
		throw:Throw ->
		    Throw;
		E:R ->
		    ?ERROR_MSG("Unknown ~p:~p, ~p", [E, R, erlang:get_stacktrace()]), 
		    {error, list_certificates}
	    end;
	false ->
	    String = io_lib:format("Invalid verbose  option: ~p", [Verbose]),
	    {invalid_option, String}
    end.

-spec list_certificates0(verbose_opt()) -> [string()] | [any()].
list_certificates0(Verbose) ->
    Certs = read_certificates_persistent(),
    [format_certificate(DataCert, Verbose) || {_Key, DataCert} <- Certs].

%% TODO: Make this cleaner and more robust
-spec format_certificate(data_cert(), verbose_opt()) -> string().
format_certificate(DataCert, Verbose) ->
    #data_cert{
       domain = DomainName,
       pem = PemCert,
       path = Path
      } = DataCert,

    try
	Certificate = pem_to_certificate(PemCert),

	%% Find the commonName
	_CommonName = get_commonName(Certificate),

	%% Find the notAfter date
	NotAfter = get_notAfter(Certificate),

	%% Find the subjectAltNames
	SANs = get_subjectAltNames(Certificate),

	case Verbose of
	    "plain" ->
		format_certificate_plain(DomainName, SANs, NotAfter, Path);
	    "verbose" ->
		format_certificate_verbose(DomainName, SANs, NotAfter, PemCert)
	end
    catch
	E:R ->
	    ?ERROR_MSG("Unknown ~p:~p, ~p", [E, R, erlang:get_stacktrace()]), 
	    fail_format_certificate(DomainName)
    end.

-spec format_certificate_plain(bitstring(), [string()], {expired | ok, string()}, string()) 
			      -> string().
format_certificate_plain(DomainName, SANs, NotAfter, Path) ->
    Result = lists:flatten(io_lib:format(
			     "  Domain: ~s~n" 
			     "~s"
			     "    ~s~n" 
			     "    Path: ~s", 
			     [DomainName,
			      lists:flatten([io_lib:format("    SAN: ~s~n", [SAN]) || SAN <- SANs]),
			      format_validity(NotAfter), Path])),
    Result.

-spec format_certificate_verbose(bitstring(), [string()], {expired | ok, string()}, bitstring()) 
				-> string().
format_certificate_verbose(DomainName, SANs, NotAfter, PemCert) ->
    Result = lists:flatten(io_lib:format(
			     "  Domain: ~s~n"
			     "~s" 
			     "    ~s~n" 
			     "    Certificate In PEM format: ~n~s", 
			     [DomainName, 
			      lists:flatten([io_lib:format("    SAN: ~s~n", [SAN]) || SAN <- SANs]),
			      format_validity(NotAfter), PemCert])),
    Result.

-spec format_validity({'expired' | 'ok', string()}) -> string().
format_validity({expired, NotAfter}) ->
    io_lib:format("Expired at: ~s UTC", [NotAfter]);
format_validity({ok, NotAfter}) ->
    io_lib:format("Valid until: ~s UTC", [NotAfter]).

-spec fail_format_certificate(bitstring()) -> string().
fail_format_certificate(DomainName) ->
    Result = lists:flatten(io_lib:format(
			     "  Domain: ~s~n" 
			     "    Failed to format Certificate", 
			     [DomainName])),
    Result.

-spec get_commonName(#'Certificate'{}) -> string().
get_commonName(#'Certificate'{tbsCertificate = TbsCertificate}) ->
    #'TBSCertificate'{
       subject = {rdnSequence, SubjectList}
      } = TbsCertificate, 

    %% TODO: Not the best way to find the commonName
    ShallowSubjectList = [Attribute || [Attribute] <- SubjectList],
    {_, _, CommonName} = lists:keyfind(attribute_oid(commonName), 2, ShallowSubjectList),

    %% TODO: Remove the length-encoding from the commonName before returning it
    CommonName.

-spec get_notAfter(#'Certificate'{}) -> {expired | ok, string()}.
get_notAfter(Certificate) ->
    UtcTime = get_utc_validity(Certificate),
    %% TODO: Find a library function to decode utc time
    [Y1,Y2,MO1,MO2,D1,D2,H1,H2,MI1,MI2,S1,S2,$Z] = UtcTime,
    YEAR = case list_to_integer([Y1,Y2]) >= 50 of
	       true -> "19" ++ [Y1,Y2];
	       _ -> "20" ++ [Y1,Y2]
	   end,
    NotAfter = lists:flatten(io_lib:format("~s-~s-~s ~s:~s:~s", 
					   [YEAR, [MO1,MO2], [D1,D2],
					    [H1,H2], [MI1,MI2], [S1,S2]])), 

    case close_to_expire(UtcTime, 0) of
	true ->
	    {expired, NotAfter};
	false ->
	    {ok, NotAfter}
    end.

-spec get_subjectAltNames(#'Certificate'{}) -> [string()].
get_subjectAltNames(#'Certificate'{tbsCertificate = TbsCertificate}) ->
    #'TBSCertificate'{
       extensions = Exts
      } = TbsCertificate,

    EncodedSANs = [Val || #'Extension'{extnID = Oid, extnValue = Val} <- Exts, 
			  Oid =:= attribute_oid(subjectAltName)],

    lists:flatmap(
      fun(EncSAN) ->
	      SANs0 = public_key:der_decode('SubjectAltName', EncSAN),
	      [Name || {dNSName, Name} <- SANs0]
      end, EncodedSANs).

    

-spec get_utc_validity(#'Certificate'{}) -> string().
get_utc_validity(#'Certificate'{tbsCertificate = TbsCertificate}) ->
    #'TBSCertificate'{
       validity = Validity
      } = TbsCertificate,

    #'Validity'{notAfter = {utcTime, UtcTime}} = Validity,
    UtcTime.

%%
%% Revoke Certificate
%%

revoke_certificate(DomainOrFile) ->
    case is_valid_revoke_cert(DomainOrFile) of
	true ->
	    revoke_certificates(DomainOrFile);
	false ->
	    String = io_lib:format("Bad argument: ~s", [DomainOrFile]),
	    {invalid_argument, String}
    end.

-spec revoke_certificates(string()) -> {ok, deleted} | {error, _}.
revoke_certificates(DomainOrFile) ->
    try
	CAUrl = get_config_ca_url(),
	revoke_certificate0(CAUrl, DomainOrFile)
    catch
	throw:Throw ->
	    Throw;
	E:R ->
	    ?ERROR_MSG("Unknown ~p:~p, ~p", [E, R, erlang:get_stacktrace()]), 
	    {error, revoke_certificate}
    end.	

-spec revoke_certificate0(url(), string()) -> {ok, deleted}.
revoke_certificate0(CAUrl, DomainOrFile) ->
    ParsedCert = parse_revoke_cert_argument(DomainOrFile),
    revoke_certificate1(CAUrl, ParsedCert).

-spec revoke_certificate1(url(), {domain, bitstring()} | {file, file:filename()}) -> 
				 {ok, deleted}.
revoke_certificate1(CAUrl, {domain, Domain}) ->
    case domain_certificate_exists(Domain) of
	{Domain, Cert = #data_cert{pem=PemCert}} ->
	    ok = revoke_certificate2(CAUrl, PemCert),
	    ok = remove_certificate_persistent(Cert),
	    {ok, deleted};
	false ->
	    ?ERROR_MSG("Certificate for domain: ~p not found", [Domain]),
	    throw({error, not_found})
    end;
revoke_certificate1(CAUrl, {file, File}) ->
    case file:read_file(File) of
	{ok, Pem} ->
	    ok = revoke_certificate2(CAUrl, Pem),
	    {ok, deleted};
	{error, Reason} ->
	    ?ERROR_MSG("Error: ~p reading pem certificate-key file: ~p", [Reason, File]),
	    throw({error, Reason})
    end.
	

-spec revoke_certificate2(url(), pem()) -> ok.
revoke_certificate2(CAUrl, PemEncodedCert) ->
    {Certificate, CertPrivateKey} = prepare_certificate_revoke(PemEncodedCert),

    {ok, Dirs, Nonce} = ejabberd_acme_comm:directory(CAUrl),

    Req = [{<<"certificate">>, Certificate}],
    {ok, [], _Nonce1} = ejabberd_acme_comm:revoke_cert(Dirs, CertPrivateKey, Req, Nonce),
    ok.

-spec parse_revoke_cert_argument(string()) -> {domain, bitstring()} | {file, file:filename()}.
parse_revoke_cert_argument([$f, $i, $l, $e, $:|File]) ->
    {file, File};
parse_revoke_cert_argument([$d, $o, $m, $a, $i, $n, $: | Domain]) ->
    {domain, list_to_bitstring(Domain)}.

-spec prepare_certificate_revoke(pem()) -> {bitstring(), jose_jwk:key()}.
prepare_certificate_revoke(PemEncodedCert) ->
    PemList = public_key:pem_decode(PemEncodedCert),
    PemCertEnc = lists:keyfind('Certificate', 1, PemList),
    PemCert = public_key:pem_entry_decode(PemCertEnc),
    DerCert = public_key:der_encode('Certificate', PemCert),
    Base64Cert = base64url:encode(DerCert),

    {ok, Key} = find_private_key_in_pem(PemEncodedCert),    
    {Base64Cert, Key}.

-spec domain_certificate_exists(bitstring()) -> {bitstring(), data_cert()} | false.    
domain_certificate_exists(Domain) ->
    Certs = read_certificates_persistent(),
    lists:keyfind(Domain, 1, Certs).

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%%
%% Certificate Request Functions
%%
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%

%% For now we accept only generating a key of
%% specific type for signing the csr

-spec make_csr(proplist(), [{dNSName, bitstring()}]) 
	      -> {binary(), jose_jwk:key()}.
make_csr(Attributes, SANs) ->
    Key = generate_key(),
    {_, KeyKey} = jose_jwk:to_key(Key),
    KeyPub = to_public(Key),
    try
	SubPKInfoAlgo = subject_pk_info_algo(KeyPub),
	{ok, RawBinPubKey} = raw_binary_public_key(KeyPub),
	SubPKInfo = subject_pk_info(SubPKInfoAlgo, RawBinPubKey),
	{ok, Subject} = attributes_from_list(Attributes),
	ExtensionRequest = extension_request(SANs),
	CRI = certificate_request_info(SubPKInfo, Subject, ExtensionRequest),
	{ok, EncodedCRI} = der_encode(
			     'CertificationRequestInfo',
			     CRI),
	SignedCRI = public_key:sign(EncodedCRI, 'sha256', KeyKey),
	SignatureAlgo = signature_algo(Key, 'sha256'),
	CSR = certification_request(CRI, SignatureAlgo, SignedCRI),
	{ok, DerCSR} = der_encode(
			 'CertificationRequest',
			 CSR),
	Result = base64url:encode(DerCSR),
	{Result, Key}
    catch
	_:{badmatch, {error, bad_public_key}} ->
	    {error, bad_public_key};
	_:{badmatch, {error, bad_attributes}} ->
	    {error, bad_public_key};
	_:{badmatch, {error, der_encode}} ->
	    {error, der_encode}
    end.



subject_pk_info_algo(_KeyPub) ->
    #'SubjectPublicKeyInfoAlgorithm'{
       algorithm = ?'id-ecPublicKey',
       parameters = {asn1_OPENTYPE,<<6,8,42,134,72,206,61,3,1,7>>}
      }.

subject_pk_info(Algo, RawBinPubKey) ->
    #'SubjectPublicKeyInfo-PKCS-10'{
       algorithm = Algo,
       subjectPublicKey = RawBinPubKey
      }.

extension(SANs) ->
    #'Extension'{
       extnID = attribute_oid(subjectAltName),
       critical = false,
       extnValue = public_key:der_encode('SubjectAltName', SANs)}.

extension_request(SANs) ->
    #'AttributePKCS-10'{
       type = ?'pkcs-9-at-extensionRequest',
       values = [{'asn1_OPENTYPE', 
		  public_key:der_encode(
		    'ExtensionRequest', 
		    [extension(SANs)])}]
      }.

certificate_request_info(SubPKInfo, Subject, ExtensionRequest) ->
    #'CertificationRequestInfo'{
       version = 0,
       subject = Subject,
       subjectPKInfo = SubPKInfo,
       attributes = [ExtensionRequest]
      }.

signature_algo(_Key, _Hash) ->
    #'CertificationRequest_signatureAlgorithm'{
       algorithm = ?'ecdsa-with-SHA256',
       parameters = asn1_NOVALUE
      }.

certification_request(CRI, SignatureAlgo, SignedCRI) ->
    #'CertificationRequest'{
       certificationRequestInfo = CRI,
       signatureAlgorithm = SignatureAlgo,
       signature = SignedCRI
      }.

raw_binary_public_key(KeyPub) ->
    try
	{_, RawPubKey} = jose_jwk:to_key(KeyPub),
	{{_, RawBinPubKey}, _} = RawPubKey,
	{ok, RawBinPubKey}
    catch
	_:_ ->
	    ?ERROR_MSG("Bad public key: ~p~n", [KeyPub]),
	    {error, bad_public_key}
    end.

der_encode(Type, Term) ->
    try
	{ok, public_key:der_encode(Type, Term)}
    catch
	_:_ ->
	    ?ERROR_MSG("Cannot DER encode: ~p, with asn1type: ~p", [Term, Type]),
	    {error, der_encode}
    end.

%%
%% Attributes Parser
%%

attributes_from_list(Attrs) ->
    ParsedAttrs = [attribute_parser_fun(Attr) || Attr <- Attrs],
    case lists:any(fun is_error/1, ParsedAttrs) of
	true ->
	    {error, bad_attributes};
	false ->
	    {ok, {rdnSequence, [[PAttr] || PAttr <- ParsedAttrs]}}
    end.

attribute_parser_fun({AttrName, AttrVal}) ->
    try
	#'AttributeTypeAndValue'{
	   type = attribute_oid(AttrName),
	   %% TODO: Check if every attribute should be encoded as
	   %% common name. Actually it doesn't matter in
	   %% practice. Only in theory in order to have cleaner code.
	   value = public_key:der_encode('X520CommonName', {printableString, AttrVal})
	   %% value = length_bitstring(list_to_bitstring(AttrVal))
	  }
    catch
	_:_ ->
	    ?ERROR_MSG("Bad attribute: ~p~n", [{AttrName, AttrVal}]),
	    {error, bad_attributes}
    end.

-spec attribute_oid(atom()) -> tuple() | no_return().
attribute_oid(commonName) -> ?'id-at-commonName';
attribute_oid(countryName) -> ?'id-at-countryName';
attribute_oid(stateOrProvinceName) -> ?'id-at-stateOrProvinceName';
attribute_oid(localityName) -> ?'id-at-localityName';
attribute_oid(organizationName) -> ?'id-at-organizationName';
attribute_oid(subjectAltName) -> ?'id-ce-subjectAltName';
attribute_oid(_) -> error(bad_attributes).



%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%%
%% Useful funs
%%
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%

-spec location_to_id(url()) -> {ok, string()} | {error, not_found}.
location_to_id(Url0) ->
    Url = string:strip(Url0, right, $/),
    case string:rchr(Url, $/) of
	0 ->
	    ?ERROR_MSG("Couldn't find id in url: ~p~n", [Url]),
	    {error, not_found};
	Ind ->
	    {ok, string:sub_string(Url, Ind+1)}
    end.

-spec get_challenges(proplist()) -> [{proplist()}].
get_challenges(Body) ->
    {<<"challenges">>, Challenges} = proplists:lookup(<<"challenges">>, Body),
    Challenges.

-spec not_before_not_after() -> {binary(), binary()}.
not_before_not_after() ->
    {Date, Time} = calendar:universal_time(),
    NotBefore = encode_calendar_datetime({Date, Time}),
    %% The certificate will be valid for 90 Days after today
    AfterDate = add_days_to_date(90, Date),
    NotAfter = encode_calendar_datetime({AfterDate, Time}),
    {NotBefore, NotAfter}.

-spec to_public(jose_jwk:key()) -> jose_jwk:key().
to_public(PrivateKey) ->
    jose_jwk:to_public(PrivateKey).

-spec pem_to_certificate(pem()) -> #'Certificate'{}.
pem_to_certificate(Pem) ->
    PemList = public_key:pem_decode(Pem),
    PemEntryCert = lists:keyfind('Certificate', 1, PemList),
    Certificate = public_key:pem_entry_decode(PemEntryCert),
    Certificate.

-spec add_days_to_date(integer(), calendar:date()) -> calendar:date().
add_days_to_date(Days, Date) ->
    Date1 = calendar:date_to_gregorian_days(Date),
    calendar:gregorian_days_to_date(Date1 + Days).

-spec encode_calendar_datetime(calendar:datetime()) -> binary().
encode_calendar_datetime({{Year, Month, Day}, {Hour, Minute, Second}}) ->
    list_to_binary(io_lib:format("~4..0B-~2..0B-~2..0BT"
				 "~2..0B:~2..0B:~2..0BZ",
				 [Year, Month, Day, Hour, Minute, Second])).

%% TODO: Find a better and more robust way to parse the utc string
-spec utc_string_to_datetime(string()) -> calendar:datetime().
utc_string_to_datetime(UtcString) ->
    try
	[Y1,Y2,MO1,MO2,D1,D2,H1,H2,MI1,MI2,S1,S2,$Z] = UtcString,
	Year = list_to_integer("20" ++ [Y1,Y2]),
	Month = list_to_integer([MO1, MO2]),
	Day = list_to_integer([D1,D2]),
	Hour = list_to_integer([H1,H2]),
	Minute = list_to_integer([MI1,MI2]),
	Second = list_to_integer([S1,S2]),
	{{Year, Month, Day}, {Hour, Minute, Second}}
    catch
	_:_ ->
	    ?ERROR_MSG("Unable to parse UTC string", []),
	    throw({error, utc_string_to_datetime})
    end.

-spec find_private_key_in_pem(pem()) -> {ok, jose_jwk:key()} | false.
find_private_key_in_pem(Pem) ->
    PemList = public_key:pem_decode(Pem),
    case find_private_key_in_pem1(private_key_types(), PemList) of
	false ->
	    false;
	PemKey ->
	    Key = public_key:pem_entry_decode(PemKey),
	    JoseKey = jose_jwk:from_key(Key),
	    {ok, JoseKey}
    end.
	    

-spec find_private_key_in_pem1([public_key:pki_asn1_type()],
			       [public_key:pem_entry()]) ->
				      public_key:pem_entry() | false.
find_private_key_in_pem1([], _PemList) ->
    false;
find_private_key_in_pem1([Type|Types], PemList) ->
    case lists:keyfind(Type, 1, PemList) of
	false ->
	    find_private_key_in_pem1(Types, PemList);
	Key ->
	    Key
    end.


-spec parse_domain_string(string()) -> [string()].
parse_domain_string(DomainString) ->
    string:tokens(DomainString, ";").

-spec private_key_types() -> [public_key:pki_asn1_type()].
private_key_types() ->
    ['RSAPrivateKey',
     'DSAPrivateKey',
     'ECPrivateKey'].

-spec find_all_sub_domains(bitstring()) -> [bitstring()].
find_all_sub_domains(DomainName) ->
    AllRoutes = ejabberd_router:get_all_routes(),
    DomainLen = size(DomainName),
    [Route || Route <- AllRoutes,  
	      binary:longest_common_suffix([DomainName, Route]) 
		  =:= DomainLen].
    

-spec is_error(_) -> boolean().
is_error({error, _}) -> true;
is_error({error, _, _}) -> true;
is_error(_) -> false.

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%%
%% Handle the persistent data structure
%%
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-spec data_empty() -> [].
data_empty() ->
    [].

%%
%% Account
%%

-spec data_get_account(acme_data()) -> {ok, list(), url(), jose_jwk:key()} | none.
data_get_account(Data) ->
    case lists:keyfind(account, 1, Data) of
	{account, #data_acc{id = AccId, ca_url = CAUrl, key = PrivateKey}} ->
	    {ok, AccId, CAUrl,  PrivateKey};
        false ->
	    none
    end.

-spec data_set_account(acme_data(), {list(), url(), jose_jwk:key()}) -> acme_data().
data_set_account(Data, {AccId, CAUrl, PrivateKey}) -> 
    NewAcc = {account, #data_acc{id = AccId, ca_url = CAUrl, key = PrivateKey}},
    lists:keystore(account, 1, Data, NewAcc).

%%
%% Certificates
%% 

-spec data_get_certificates(acme_data()) -> data_certs().
data_get_certificates(Data) ->
    case lists:keyfind(certs, 1, Data) of
	{certs, Certs} ->
	    Certs;
        false ->
	    []
    end.

-spec data_set_certificates(acme_data(), data_certs()) -> acme_data().
data_set_certificates(Data, NewCerts) -> 
    lists:keystore(certs, 1, Data, {certs, NewCerts}).

%% ATM we preserve one certificate for each domain
-spec data_add_certificate(acme_data(), data_cert()) -> acme_data().
data_add_certificate(Data, DataCert = #data_cert{domain=Domain}) ->
    Certs = data_get_certificates(Data),
    NewCerts = lists:keystore(Domain, 1, Certs, {Domain, DataCert}),
    data_set_certificates(Data, NewCerts).

-spec data_remove_certificate(acme_data(), data_cert()) -> acme_data().
data_remove_certificate(Data, _DataCert = #data_cert{domain=Domain}) ->
    Certs = data_get_certificates(Data),
    NewCerts = lists:keydelete(Domain, 1, Certs),
    data_set_certificates(Data, NewCerts).


%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%%
%% Handle Config and Persistence Files
%%
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%

-spec persistent_file() -> file:filename().
persistent_file() ->
    AcmeDir = acme_certs_dir(),
    filename:join(AcmeDir, "acme.DAT").

%% The persistent file should be read and written only by its owner
-spec file_mode() -> 384.
file_mode() ->
    8#600.

-spec read_persistent() -> {ok, acme_data()} | no_return().
read_persistent() ->
    case file:read_file(persistent_file()) of
	{ok, Binary} ->
	    {ok, binary_to_term(Binary)};
	{error, enoent} ->
	    create_persistent(),
	    {ok, data_empty()};
	{error, Reason} ->
	    ?ERROR_MSG("Error: ~p reading acme data file", [Reason]),
	    throw({error, Reason})
    end.

-spec write_persistent(acme_data()) -> ok | no_return().
write_persistent(Data) ->
    Binary = term_to_binary(Data),
    case file:write_file(persistent_file(), Binary) of
	ok -> ok;
	{error, Reason} ->
	    ?ERROR_MSG("Error: ~p writing acme data file", [Reason]),
	    throw({error, Reason})
    end.    

-spec create_persistent() -> ok | no_return().
create_persistent() ->
    Binary = term_to_binary(data_empty()),
    case file:write_file(persistent_file(), Binary) of
	ok ->
	    case file:change_mode(persistent_file(), file_mode()) of
		ok -> ok;
		{error, Reason} ->
		    ?ERROR_MSG("Error: ~p changing acme data file mode", [Reason]),
		    throw({error, Reason})
	    end;
	{error, Reason} ->
	    ?ERROR_MSG("Error: ~p creating acme data file", [Reason]),
	    throw({error, Reason})
    end.        

-spec write_account_persistent({list(), url(), jose_jwk:key()}) -> ok | no_return().
write_account_persistent({AccId, CAUrl, PrivateKey}) ->
    {ok, Data} = read_persistent(),
    NewData = data_set_account(Data, {AccId, CAUrl, PrivateKey}),
    ok = write_persistent(NewData).

-spec read_account_persistent() -> {ok, list(), url(), jose_jwk:key()} | none.
read_account_persistent() ->
    {ok, Data} = read_persistent(),
    data_get_account(Data).

-spec read_certificates_persistent() -> data_certs().
read_certificates_persistent() ->
    {ok, Data} = read_persistent(),
    data_get_certificates(Data).

-spec add_certificate_persistent(data_cert()) -> ok.
add_certificate_persistent(DataCert) ->
    {ok, Data} = read_persistent(),
    NewData = data_add_certificate(Data, DataCert),
    ok = write_persistent(NewData).

-spec remove_certificate_persistent(data_cert()) -> ok.
remove_certificate_persistent(DataCert) ->
    {ok, Data} = read_persistent(),
    NewData = data_remove_certificate(Data, DataCert),
    ok = write_persistent(NewData).

-spec save_certificate({ok, bitstring(), binary()} | {error, _, _}) -> 
			      {ok, bitstring(), saved} | {error, bitstring(), _}.
save_certificate({error, _, _} = Error) ->
    Error;
save_certificate({ok, DomainName, Cert}) ->
    try
        CertDir = acme_certs_dir(),
	DomainString = bitstring_to_list(DomainName),
	CertificateFile = filename:join([CertDir, DomainString ++ ".pem"]),
	%% TODO: At some point do the following using a Transaction so
	%% that there is no certificate saved if it cannot be added in
	%% certificate persistent storage
	write_cert(CertificateFile, Cert, DomainName),
	ok = ejabberd_pkix:add_certfile(CertificateFile),
	DataCert = #data_cert{
		      domain = DomainName,
		      pem = Cert,
		      path = CertificateFile
		     },
	add_certificate_persistent(DataCert),
	{ok, DomainName, saved}
    catch
	throw:Throw ->
	    Throw;
	E:R ->
	    ?ERROR_MSG("Unknown ~p:~p, ~p", [E, R, erlang:get_stacktrace()]), 
	    {error, DomainName, saving}
    end.

-spec save_renewed_certificate({ok, bitstring(), _} | {error, _, _}) -> 
				      {ok, bitstring(), _} | {error, bitstring(), _}.
save_renewed_certificate({error, _, _} = Error) ->
    Error;
save_renewed_certificate({ok, _, no_expire} = Cert) ->
    Cert;
save_renewed_certificate({ok, DomainName, Cert}) ->
    save_certificate({ok, DomainName, Cert}).

-spec register_certfiles() -> ok.
register_certfiles() ->
    Dir = acme_certs_dir(),
    Paths = filelib:wildcard(filename:join(Dir, "*.pem")),
    lists:foreach(
      fun(Path) ->
	      ejabberd_pkix:add_certfile(Path)
      end, Paths).

-spec write_cert(file:filename(), binary(), bitstring()) -> {ok, bitstring(), saved}.
write_cert(CertificateFile, Cert, DomainName) ->
    case file:write_file(CertificateFile, Cert) of
	ok ->
	    case file:change_mode(CertificateFile, file_mode()) of
		ok -> ok;
		{error, Why} ->
		    ?WARNING_MSG("Failed to change mode of file ~s: ~s",
				 [CertificateFile, file:format_error(Why)])
	    end,
	    {ok, DomainName, saved};
	{error, Reason} ->
	    ?ERROR_MSG("Error: ~p saving certificate at file: ~p",
		       [Reason, CertificateFile]),
	    throw({error, DomainName, saving})
    end.

-spec get_config_acme() -> acme_config().
get_config_acme() ->
    case ejabberd_config:get_option(acme, undefined) of
	undefined ->
	    ?WARNING_MSG("No acme configuration has been specified", []),
	    %% throw({error, configuration});
	    [];
        Acme ->
	    Acme
    end.

-spec get_config_contact() -> bitstring().
get_config_contact() ->
    Acme = get_config_acme(),
    case lists:keyfind(contact, 1, Acme) of
	{contact, Contact} ->
	    Contact;
	false ->
	    ?WARNING_MSG("No contact has been specified in configuration", []),
	    ?DEFAULT_CONFIG_CONTACT
	    %% throw({error, configuration_contact})
    end.

-spec get_config_ca_url() -> url().
get_config_ca_url() ->
    Acme = get_config_acme(),
    case lists:keyfind(ca_url, 1, Acme) of
	{ca_url, CAUrl} ->
	    CAUrl;
	false ->
	    ?ERROR_MSG("No CA url has been specified in configuration", []),
	    ?DEFAULT_CONFIG_CA_URL
	    %% throw({error, configuration_ca_url})
    end.


-spec get_config_hosts() -> [bitstring()].
get_config_hosts() ->
    case ejabberd_config:get_option(hosts, undefined) of
	undefined ->
	    ?ERROR_MSG("No hosts have been specified in configuration", []),
	    throw({error, configuration_hosts});
        Hosts ->
	    Hosts
    end.

-spec acme_certs_dir() -> file:filename().
acme_certs_dir() ->
    filename:join(ejabberd_pkix:certs_dir(), "acme").

generate_key() ->
    jose_jwk:generate_key({ec, secp256r1}).

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%%
%% Option Parsing Code
%%
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-spec opt_type(acme) -> fun((acme_config()) -> (acme_config()));
	      (atom()) -> [atom()].
opt_type(acme) ->
    fun(L) ->
	    lists:map(
	      fun({ca_url, URL}) ->
		      URL1 = binary_to_list(URL),
		      {ok, _} = http_uri:parse(URL1),
		      {ca_url, URL1};
		 ({contact, Contact}) ->
		      [<<_, _/binary>>, <<_, _/binary>>] =
			  binary:split(Contact, <<":">>),
		      {contact, Contact}
	      end, L)
    end;
opt_type(_) ->
    [acme].