Verify that known roots are indeed signing themselves.

This filters out certificates with signing algorithms that we can't
handle.

Also, make unit tests better.

2 files changed, 52 insertions, 22 deletions

diff --git a/src/catlfish.erl b/src/catlfish.erl
index 765a8a6..3956eec 100644
--- a/src/catlfish.erl
+++ b/src/catlfish.erl
@@ -200,9 +200,17 @@ known_roots(Directory, CacheUsage) ->
     end.
 
 read_files_and_update_table(Directory) ->
-    L = x509:read_pemfiles_from_dir(Directory),
-    true = ets:insert(?CACHE_TABLE, {?ROOTS_CACHE_KEY, L}),
-    L.
+    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.
@@ -218,7 +226,7 @@ read_pemfiles_test_() ->
      end,
      fun(_) -> ets:delete(?CACHE_TABLE, ?ROOTS_CACHE_KEY) end,
      fun({L, LCached}) ->
-             [?_assertMatch(7, length(L)),
+             [?_assertMatch(4, length(L)),
               ?_assertEqual(L, LCached)]
      end}.
 
diff --git a/src/x509.erl b/src/x509.erl
index a0aaed4..9030e04 100644
--- a/src/x509.erl
+++ b/src/x509.erl
@@ -2,7 +2,8 @@
 %%% See LICENSE for licensing information.
 
 -module(x509).
--export([normalise_chain/2, cert_string/1, read_pemfiles_from_dir/1]).
+-export([normalise_chain/2, cert_string/1, read_pemfiles_from_dir/1,
+         self_signed/1]).
 
 -include_lib("public_key/include/public_key.hrl").
 -include_lib("eunit/include/eunit.hrl").
@@ -27,9 +28,15 @@ normalise_chain(AcceptableRootCerts, CertChain) ->
 
 %%%%%%%%%%%%%%%%%%%%
 %% @doc Verify that the leaf cert or precert has a valid chain back to
-%% an acceptable root cert. Order of certificates in second argument
-%% is: leaf cert in head, chain in tail. Order of first argument is
-%% irrelevant.
+%% an acceptable root cert. The order of certificates in the second
+%% argument is: leaf cert in head, chain in tail. Order of first
+%% argument is irrelevant.
+%%
+%% Return {false, Reason} or {true, ListWithRoot}. Note that
+%% ListWithRoot is the empty list when the root of the chain is found
+%% amongst the acceptable root certs. Otherwise it contains exactly
+%% one element, a CA cert from the acceptable root certs signing the
+%% root of the chain.
 -spec valid_chain_p([binary()], [binary()], integer()) ->
                            {false, reason()} | {true, list()}.
 valid_chain_p(_, _, MaxChainLength) when MaxChainLength =< 0 ->
@@ -161,6 +168,10 @@ parsable_cert_p(Der) ->
             false
     end.
 
+-spec self_signed([binary()]) -> [binary()].
+self_signed(L) ->
+    lists:filter(fun(Cert) -> signed_by_p(Cert, Cert) end, L).
+
 %%%%%%%%%%%%%%%%%%%%
 %% Precertificates according to draft-ietf-trans-rfc6962-bis-04.
 
@@ -210,6 +221,7 @@ ders_from_pemfiles(Dir, Filenames) ->
       [ders_from_pemfile(filename:join(Dir, X)) || X <- Filenames]).
 
 ders_from_pemfile(Filename) ->
+    lager:debug("reading PEM from ~s", [Filename]),
     PemBins = pems_from_file(Filename),
     Pems = case (catch public_key:pem_decode(PemBins)) of
                {'EXIT', Reason} ->
@@ -272,27 +284,37 @@ valid_cert_test_() ->
      fun(_) -> ok end,
      fun({KnownRoots, Chains}) ->
              [
-              %% self-signed, not a valid OTPCertificate:
+              %% Self-signed but verified against itself so pass.
+              %% Not a valid OTPCertificate:
               %% {error,{asn1,{invalid_choice_tag,{22,<<"US">>}}}}
               %% 'OTP-PUB-KEY':Func('OTP-X520countryname', Value0)
-              %% FIXME: this doesn't make much sense -- is my environment borked?
-              ?_assertMatch({true, _},
-                            valid_chain_p(lists:nth(1, Chains),
-                                          lists:nth(1, Chains), 10)),
-              %% self-signed
+              %% FIXME: This error doesn't make much sense -- is my
+              %% environment borked?
+              ?_assertMatch({true, _}, valid_chain_p(lists:nth(1, Chains),
+                                                     lists:nth(1, Chains), 10)),
+              %% Self-signed so fail.
               ?_assertMatch({false, root_unknown},
                             valid_chain_p(KnownRoots,
                                           lists:nth(2, Chains), 10)),
-              %% leaf signed by known CA
-              ?_assertMatch({true, _},
-                            valid_chain_p(KnownRoots,
-                                          lists:nth(3, Chains), 10)),
-              %% bug CATLFISH-19 --> [info] rejecting "3ee62cb678014c14d22ebf96f44cc899adea72f1": chain_broken
+              %% Leaf signed by known CA, pass.
+              ?_assertMatch({true, _}, valid_chain_p(KnownRoots,
+                                                     lists:nth(3, Chains), 10)),
+              %% Proper 3-depth chain with root in KnownRoots, pass.
+              %% Bug CATLFISH-19 --> [info] rejecting "3ee62cb678014c14d22ebf96f44cc899adea72f1": chain_broken
               %% leaf sha1: 3ee62cb678014c14d22ebf96f44cc899adea72f1
               %% leaf Subject: C=KR, O=Government of Korea, OU=Group of Server, OU=\xEA\xB5\x90\xEC\x9C\xA1\xEA\xB3\xBC\xED\x95\x99\xEA\xB8\xB0\xEC\x88\xA0\xEB\xB6\x80, CN=www.berea.ac.kr, CN=haksa.bits.ac.kr
-              ?_assertMatch({true, _},
-                            valid_chain_p(lists:nth(4, Chains),
-                                          lists:nth(4, Chains), 10))
+              ?_assertMatch({true, _}, valid_chain_p(KnownRoots,
+                                                     lists:nth(4, Chains), 3)),
+              %% Verify against self, pass.
+              %% Bug CATLFISH-??, can't handle issuer keytype ECPoint.
+              %% Issuer sha1: 6969562e4080f424a1e7199f14baf3ee58ab6abb
+              ?_assertMatch(true, signed_by_p(hd(lists:nth(5, Chains)),
+                                              hd(lists:nth(5, Chains)))),
+              %% Unsupported signature algorithm MD2-RSA, fail.
+              %% Signature Algorithm: md2WithRSAEncryption
+              %% CA cert with sha1 96974cd6b663a7184526b1d648ad815cf51e801a
+              ?_assertMatch(false, signed_by_p(hd(lists:nth(6, Chains)),
+                                               hd(lists:nth(6, Chains))))
               ] end}.
 
 chain_test_() ->