path: root/src/catlfish.erl

%%% Copyright (c) 2014-2015, NORDUnet A/S.
%%% See LICENSE for licensing information.

-module(catlfish).
-export([add_chain/3, entries/2, entry_and_proof/2]).
-export([known_roots/0, update_known_roots/0]).
-export([init_cache_table/0]).
-export([entryhash_from_entry/1, verify_entry/1, verify_entry/2, spt_data/1]).
-include_lib("eunit/include/eunit.hrl").

-define(PROTOCOL_VERSION, 0).

-type signature_type() :: certificate_timestamp | tree_hash | test. % uint8
-type entry_type() :: x509_entry | precert_entry | test. % uint16
-type leaf_type() :: timestamped_entry | test.           % uint8
-type leaf_version() :: v1 | v2.                         % uint8

-record(mtl, {leaf_version :: leaf_version(),
              leaf_type :: leaf_type(),
              entry :: timestamped_entry()}).
-type mtl() :: #mtl{}.

-record(timestamped_entry, {timestamp :: integer(),
                            entry_type :: entry_type(),
                            signed_entry :: signed_x509_entry() |
                                            signed_precert_entry(),
                            extensions = <<>> :: binary()}).
-type timestamped_entry() :: #timestamped_entry{}.

-record(signed_x509_entry, {asn1_cert :: binary()}).
-type signed_x509_entry() :: #signed_x509_entry{}.
-record(signed_precert_entry, {issuer_key_hash :: binary(),
                               tbs_certificate :: binary()}).
-type signed_precert_entry() :: #signed_precert_entry{}.

-spec serialise(mtl() | timestamped_entry() |
                signed_x509_entry() | signed_precert_entry()) -> binary().
%% @doc Serialise a MerkleTreeLeaf as per RFC6962 Section 3.4.
serialise(#mtl{leaf_version = LeafVersion,
               leaf_type = LeafType,
               entry = TimestampedEntry}) ->
    list_to_binary(
      [serialise_leaf_version(LeafVersion),
       serialise_leaf_type(LeafType),
       serialise(TimestampedEntry)]);
%% @doc Serialise a TimestampedEntry as per RFC6962 Section 3.4.
serialise(#timestamped_entry{timestamp = Timestamp,
                             entry_type = EntryType,
                             signed_entry = SignedEntry,
                             extensions = Extensions}) ->
    list_to_binary(
      [<<Timestamp:64>>,
       serialise_entry_type(EntryType),
       serialise(SignedEntry),
       encode_tls_vector(Extensions, 2)]);
%% @doc Serialise an ASN1.Cert as per RFC6962 Section 3.1.
serialise(#signed_x509_entry{asn1_cert = Cert}) ->
    encode_tls_vector(Cert, 3);
%% @doc Serialise a PreCert as per RFC6962 Section 3.2.
serialise(#signed_precert_entry{
             issuer_key_hash = IssuerKeyHash,
             tbs_certificate = TBSCertificate}) when is_binary(IssuerKeyHash),
                                                     size(IssuerKeyHash) == 32 ->
    list_to_binary(
      [IssuerKeyHash,
       encode_tls_vector(TBSCertificate, 3)]).

serialise_leaf_version(v1) ->
    <<0:8>>;
serialise_leaf_version(v2) ->
    <<1:8>>.
deserialise_leaf_version(<<0:8>>) ->
    v1;
deserialise_leaf_version(<<1:8>>) ->
    v2.

serialise_leaf_type(timestamped_entry) ->
    <<0:8>>.
deserialise_leaf_type(<<0:8>>) ->
    timestamped_entry.

serialise_entry_type(x509_entry) ->
    <<0:16>>;
serialise_entry_type(precert_entry) ->
    <<1:16>>.
deserialise_entry_type(<<0:16>>) ->
    x509_entry;
deserialise_entry_type(<<1:16>>) ->
    precert_entry.

-spec serialise_signature_type(signature_type()) -> binary().
serialise_signature_type(certificate_timestamp) ->
    <<0:8>>.

spt_data(DBEntry) ->
    {_Type, MTLText, _Cert, _Chain} = unpack_entry(DBEntry),
    MTL = deserialise_mtl(MTLText),
    TSE = MTL#mtl.entry,
    sct_data(TSE).

sct_data(TimestampedEntry) ->
    list_to_binary([<<?PROTOCOL_VERSION:8>>,
                    serialise_signature_type(certificate_timestamp),
                    serialise(TimestampedEntry)]).

calc_sct(TimestampedEntry, Signatures) ->
    plop:serialise(
      plop:spt(sct_data(TimestampedEntry), Signatures)).

create_logentry(Type, LeafCert, CertChain) ->
    EntryType = case Type of
                    normal -> x509_entry;
                    precert -> precert_entry
                end,
    Timestamp = plop:generate_timestamp(),
    TSE = timestamped_entry(Timestamp, EntryType, LeafCert, CertChain),
    MTLText = serialise(#mtl{leaf_version = v1,
                             leaf_type = timestamped_entry,
                             entry = TSE}),
    MTLHash = ht:leaf_hash(MTLText),
    LogEntry = pack_entry(Type, MTLText, LeafCert, CertChain),
    {TSE, MTLHash, LogEntry}.

get_ratelimit_token(Type) ->
    ratelimit:get_token(Type).


maybe_add_to_db(Hash, LogEntry, TimestampedEntry, HasEntry) ->
    CachedSCTSig = plop:get_spt(Hash),

    case {HasEntry, CachedSCTSig} of
        {true, SCT} when is_binary(SCT) ->
            SCT;
        _ ->
            {ok, Signatures} = plop:add(LogEntry, Hash),
            SCT = calc_sct(TimestampedEntry, Signatures),
            plop:add_spt(Hash, SCT),
            SCT
    end.

-spec add_chain(binary(), [binary()], normal|precert) -> {[{_,_},...]}.
add_chain(LeafCert, CertChain, Type) ->
    EntryHash = crypto:hash(sha256, [LeafCert | CertChain]),
    {{TimestampedEntry, Hash, LogEntry}, HasEntry} =
        case plop:get(EntryHash) of
            notfound ->
                case get_ratelimit_token(add_chain) of
                    ok ->
                        {create_logentry(Type, LeafCert, CertChain), false};
                    _ ->
                        exit({internalerror, "Rate limiting"})
                end;
            {_Index, MTLHash, DBEntry} ->
                {_Type, MTLText, _Cert, _Chain} = unpack_entry(DBEntry),
                MTL = deserialise_mtl(MTLText),
                MTLText = serialise(MTL),       % verify FIXME: remove
                {{MTL#mtl.entry, MTLHash, DBEntry}, true}
        end,

    SCT_sig = maybe_add_to_db(Hash, LogEntry, TimestampedEntry, HasEntry),

    case HasEntry of
        false ->
            plop:commit(Hash, EntryHash, SCT_sig);
        _ ->
            none
    end,

    {[{sct_version, ?PROTOCOL_VERSION},
      {id, base64:encode(plop:get_logid())},
      {timestamp, TimestampedEntry#timestamped_entry.timestamp},
      {extensions, base64:encode(<<>>)},
      {signature, base64:encode(SCT_sig)}]}.

-spec timestamped_entry(integer(), entry_type(), binary(), binary()) ->
                               timestamped_entry().
timestamped_entry(Timestamp, EntryType, LeafCert, CertChain) ->
    SignedEntry =
        case EntryType of
            x509_entry ->
                #signed_x509_entry{asn1_cert = LeafCert};
            precert_entry ->
                {DetoxedLeafTBSCert, IssuerKeyHash} =
                    x509:detox(LeafCert, CertChain),
                #signed_precert_entry{
                   issuer_key_hash = IssuerKeyHash,
                   tbs_certificate = DetoxedLeafTBSCert}
        end,
    #timestamped_entry{timestamp = Timestamp,
                       entry_type = EntryType,
                       signed_entry = SignedEntry}.

-spec deserialise_mtl(binary()) -> mtl().
deserialise_mtl(Data) ->
    <<LeafVersionBin:1/binary,
      LeafTypeBin:1/binary,
      TimestampedEntryBin/binary>> = Data,
    #mtl{leaf_version = deserialise_leaf_version(LeafVersionBin),
         leaf_type = deserialise_leaf_type(LeafTypeBin),
         entry = deserialise_timestampedentry(TimestampedEntryBin)}.

-spec deserialise_timestampedentry(binary()) -> timestamped_entry().
deserialise_timestampedentry(Data) ->
    <<Timestamp:64, EntryTypeBin:2/binary, RestData/binary>> = Data,
    EntryType = deserialise_entry_type(EntryTypeBin),
    {SignedEntry, ExtensionsBin} =
        case EntryType of
            x509_entry ->
                deserialise_signed_x509_entry(RestData);
            precert_entry ->
                deserialise_signed_precert_entry(RestData)
        end,
    {Extensions, <<>>} = decode_tls_vector(ExtensionsBin, 2),
    #timestamped_entry{timestamp = Timestamp,
                       entry_type = EntryType,
                       signed_entry = SignedEntry,
                       extensions = Extensions}.

-spec deserialise_signed_x509_entry(binary()) -> {signed_x509_entry(), binary()}.
deserialise_signed_x509_entry(Data) ->
    {E, D} = decode_tls_vector(Data, 3),
    {#signed_x509_entry{asn1_cert = E}, D}.

-spec deserialise_signed_precert_entry(binary()) ->
                                              {signed_precert_entry(), binary()}.
deserialise_signed_precert_entry(Data) ->
    <<IssuerKeyHash:32/binary, RestData/binary>> = Data,
    {TBSCertificate, RestData2} = decode_tls_vector(RestData, 3),
    {#signed_precert_entry{issuer_key_hash = IssuerKeyHash,
                           tbs_certificate = TBSCertificate},
     RestData2}.    

serialise_extra_data(Type, Cert, Chain) ->
    EncodedChain = encode_tls_vector(
                     list_to_binary(
                       [encode_tls_vector(C, 3) || C <- Chain]), 3),
    case Type of
        normal ->
            EncodedChain;
        precert ->
            list_to_binary(
              [encode_tls_vector(Cert, 3), EncodedChain])
    end.

-spec entries(non_neg_integer(), non_neg_integer()) -> {[{entries, list()},...]}.
entries(Start, End) ->
    {[{entries, x_entries(plop:get(Start, End))}]}.

-spec entry_and_proof(non_neg_integer(), non_neg_integer()) -> {[{_,_},...]}.
entry_and_proof(Index, TreeSize) ->
    case plop:inclusion_and_entry(Index, TreeSize) of
        {ok, Entry, Path} ->
            {Type, MTLText, Cert, Chain} = unpack_entry(Entry),
            ExtraData = serialise_extra_data(Type, Cert, Chain),
            {[{leaf_input, base64:encode(MTLText)},
              {extra_data, base64:encode(ExtraData)},
              {audit_path, [base64:encode(X) || X <- Path]}]};
        {notfound, Msg} ->
            {[{success, false},
              {error_message, list_to_binary(Msg)}]}
    end.

-define(CACHE_TABLE, catlfish_cache).
init_cache_table() ->
    case ets:info(?CACHE_TABLE) of
	undefined -> ok;
	_ -> ets:delete(?CACHE_TABLE)
    end,
    ets:new(?CACHE_TABLE, [set, public, named_table]).

verify_mtl(MTL, LeafCert, CertChain) ->
    Timestamp = MTL#mtl.entry#timestamped_entry.timestamp,
    EntryType = MTL#mtl.entry#timestamped_entry.entry_type,
    TSE = timestamped_entry(Timestamp, EntryType, LeafCert, CertChain),
    case MTL of
        #mtl{leaf_version = v1,
             leaf_type = timestamped_entry,
             entry = TSE} ->
            ok;
        _ ->
            error
    end.

verify_entry(Entry) ->
    RootCerts = known_roots(),
    verify_entry(Entry, RootCerts).

%% Used from plop.
verify_entry(PackedEntry, RootCerts) ->
    {_Type, MTLText, Cert, Chain} = unpack_entry(PackedEntry),
    case x509:normalise_chain(RootCerts, [Cert | Chain]) of
        {ok, [Cert | FullChain]} ->
            case verify_mtl(deserialise_mtl(MTLText), Cert, FullChain) of
                ok ->
                    {ok, ht:leaf_hash(MTLText)};
                error ->
                    {error, "MTL verification failed"}
            end;
        {error, Reason} ->
            {error, Reason}
    end.

%% Used from plop.
entryhash_from_entry(PackedEntry) ->
    {_Type, _MTLText, Cert, Chain} = unpack_entry(PackedEntry),
    crypto:hash(sha256, [Cert | Chain]).

%% Private functions.
-spec pack_entry(normal|precert, binary(), binary(), [binary()]) -> binary().
pack_entry(Type, MTLText, EndEntityCert, CertChain) ->
    [{<<"MTL1">>, MTLText},
     {case Type of
          normal -> <<"EEC1">>;
          precert -> <<"PRC1">>
      end, EndEntityCert},
     {<<"CHN1">>,
      list_to_binary(
        [tlv:encode(<<"X509">>, E) || E <- CertChain])}].

-spec unpack_entry(binary()) -> {normal|precert, binary(), binary(), [binary()]}.
unpack_entry(Entry) ->
    [{<<"MTL1">>, MTLText}|Rest1] = Entry,
    [{EECType, EndEntityCert}|Rest2] = Rest1,
    Type = case EECType of
               <<"EEC1">> ->
                   normal;
               <<"PRC1">> ->
                   precert
           end,
    [{<<"CHN1">>, PackedChain}|_Rest3] = Rest2,
    Chain = unpack_certchain(PackedChain),
    {Type, MTLText, EndEntityCert, Chain}.

unpack_certchain(<<>>) ->
    [];
unpack_certchain(Data) ->
    {<<"X509">>, Unpacked, Rest} = tlv:decode(Data),
    [Unpacked | unpack_certchain(Rest)].

-spec x_entries([{non_neg_integer(), binary(), binary()}]) -> list().
x_entries([]) ->
    [];
x_entries([H|T]) ->
    {_Index, LeafHash, Entry} = H,
    {Type, MTLText, Cert, Chain} = unpack_entry(Entry),
    LeafHash = ht:leaf_hash(MTLText),
    ExtraData = serialise_extra_data(Type, Cert, Chain),
    [{[{leaf_input, base64:encode(MTLText)},
       {extra_data, base64:encode(ExtraData)}]} | x_entries(T)].

-spec encode_tls_vector(binary(), non_neg_integer()) -> binary().
encode_tls_vector(Binary, LengthLen) ->
    Length = byte_size(Binary),
    <<Length:LengthLen/integer-unit:8, Binary/binary>>.

-spec decode_tls_vector(binary(), non_neg_integer()) -> {binary(), binary()}.
decode_tls_vector(Binary, LengthLen) ->
    <<Length:LengthLen/integer-unit:8, Rest/binary>> = Binary,
    <<ExtractedBinary:Length/binary-unit:8, Rest2/binary>> = Rest,
    {ExtractedBinary, Rest2}.

-define(ROOTS_CACHE_KEY, roots).

update_known_roots() ->
    case application:get_env(catlfish, known_roots_path) of
        {ok, Dir} -> update_known_roots(Dir);
        undefined -> []
    end.

update_known_roots(Directory) ->
    known_roots(Directory, update_tab).

known_roots() ->
    case application:get_env(catlfish, known_roots_path) of
        {ok, Dir} -> known_roots(Dir, use_cache);
        undefined -> []
    end.

-spec known_roots(file:filename(), use_cache|update_tab) -> [binary()].
known_roots(Directory, CacheUsage) ->
    case CacheUsage of
        use_cache ->
            case ets:lookup(?CACHE_TABLE, ?ROOTS_CACHE_KEY) of
                [] ->
                    read_files_and_update_table(Directory);
                [{roots, DerList}] ->
                    DerList
            end;
        update_tab ->
            read_files_and_update_table(Directory)
    end.

read_files_and_update_table(Directory) ->
    Certs = x509:read_pemfiles_from_dir(Directory),
    Proper = x509:self_signed(Certs),
    case length(Certs) - length(Proper) of
        0 -> ok;
        N -> lager:warning(
               "Ignoring ~p root certificates not signing themselves properly",
               [N])
    end,
    true = ets:insert(?CACHE_TABLE, {?ROOTS_CACHE_KEY, Proper}),
    lager:info("Known roots imported: ~p", [length(Proper)]),
    Proper.

%%%%%%%%%%%%%%%%%%%%
%% Testing internal functions.
-define(PEMFILES_DIR_OK, "test/testdata/known_roots").
-define(PEMFILES_DIR_NONEXISTENT, "test/testdata/nonexistent-dir").

read_pemfiles_test_() ->
    {setup,
     fun() ->
             init_cache_table(),
             {known_roots(?PEMFILES_DIR_OK, update_tab),
              known_roots(?PEMFILES_DIR_OK, use_cache)}
     end,
     fun(_) -> ets:delete(?CACHE_TABLE, ?ROOTS_CACHE_KEY) end,
     fun({L, LCached}) ->
             [?_assertMatch(4, length(L)),
              ?_assertEqual(L, LCached)]
     end}.

read_pemfiles_fail_test_() ->
    {setup,
     fun() ->
             init_cache_table(),
             known_roots(?PEMFILES_DIR_NONEXISTENT, update_tab)
     end,
     fun(_) -> ets:delete(?CACHE_TABLE, ?ROOTS_CACHE_KEY) end,
     fun(Empty) -> [?_assertMatch([], Empty)] end}.