From ab4b1c9f066d8d544c97de357b674a8308ed05de Mon Sep 17 00:00:00 2001 From: Ingela Anderton Andin Date: Fri, 20 Jan 2023 13:47:39 +0100 Subject: [PATCH] public_key: Add policy checks --- lib/public_key/asn1/OTP-PKIX.asn1 | 16 + lib/public_key/doc/src/public_key.xml | 44 +- lib/public_key/doc/src/public_key_app.xml | 2 +- lib/public_key/include/public_key.hrl | 80 +- lib/public_key/src/Makefile | 1 + lib/public_key/src/pubkey_cert.erl | 1549 +++++++++++------ lib/public_key/src/pubkey_policy_tree.erl | 416 +++++ lib/public_key/src/public_key.app.src | 27 +- lib/public_key/src/public_key.erl | 50 +- lib/public_key/test/pkits_SUITE.erl | 1916 +++++++++++++++++---- lib/public_key/test/pubkey_cert_SUITE.erl | 42 +- 11 files changed, 3223 insertions(+), 920 deletions(-) create mode 100644 lib/public_key/src/pubkey_policy_tree.erl diff --git a/lib/public_key/asn1/OTP-PKIX.asn1 b/lib/public_key/asn1/OTP-PKIX.asn1 index e1d8f2e121b1..8c15bdc7eaf1 100644 --- a/lib/public_key/asn1/OTP-PKIX.asn1 +++ b/lib/public_key/asn1/OTP-PKIX.asn1 @@ -834,4 +834,20 @@ invalidityDate EXTENSION-CLASS ::= { ID id-ce-invalidityDate TYPE InvalidityDate } +-- Used to workaround that some CAs create too long User Notices + +OTPUserNotice ::= SEQUENCE { + noticeRef OTPNoticeReference OPTIONAL, + explicitText OTPDisplayText OPTIONAL} + +OTPNoticeReference ::= SEQUENCE { + organization OTPDisplayText, + noticeNumbers SEQUENCE OF INTEGER } + +OTPDisplayText ::= CHOICE { + ia5String IA5String (SIZE (1..350)), + visibleString VisibleString (SIZE (1..350)), + bmpString BMPString (SIZE (1..350)), + utf8String UTF8String (SIZE (1..350)) } + END diff --git a/lib/public_key/doc/src/public_key.xml b/lib/public_key/doc/src/public_key.xml index 501b7be95465..c726b1759547 100644 --- a/lib/public_key/doc/src/public_key.xml +++ b/lib/public_key/doc/src/public_key.xml @@ -44,7 +44,6 @@ Common Records and ASN.1 Types

All records used in this Reference Manual - are generated from ASN.1 specifications and are documented in the User's Guide. See Public-key Records. @@ -215,6 +214,12 @@ + + + + + + @@ -534,12 +539,20 @@ Performs a basic path validation according to RFC 5280.

- Performs a basic path validation according to - RFC 5280. + Performs a basic path validation according to RFC 5280. However, CRL validation is done separately by pkix_crls_validate/3 and is to be called - from the supplied verify_fun. The optional policy tree check is currently not implemented - but an empty place holder list is returned instead. + marker="#pkix_crls_validate/3">pkix_crls_validate/3 + and is to be called from the supplied verify_fun. The + policy tree check was added in OTP-26.2 and if the + certificates include policies the constrained policy set with + potential qualifiers will be returned, these values are + derived from the policy tree created as part of the path + validation algorithm. The constrained set can be constrained + only by the Certificate Authorities or also by the user when + the option policy_set is provided to this + function. The qualifiers convey information about the valid + policy and is intended as information to end users.

Available options:

@@ -583,6 +596,25 @@ fun(OtpCert :: #'OTPCertificate'{}, be PEER, CA, ROOT-CA, if it is 2, the path can be PEER, CA, CA, ROOT-CA, and so on. + + {policy_set, [oid()]} + The set of policies that will be accepted, defaults to the special + value [?anyPolicy] that will accept all policies. + + + {explicit_policy, boolean()} + Explicitly require that each certificate in the path must include + at least one of the certificate policies in the + policy_set. + + {inhibit_policy_mapping, boolean()} + Prevent policies to be mapped to other policies. + + {inhibit_any_policy, boolean()} + Prevent the special policy ?anyPolicy from being + accepted. + +

Explanations of reasons for a bad certificate:

diff --git a/lib/public_key/doc/src/public_key_app.xml b/lib/public_key/doc/src/public_key_app.xml index 497c4fbd77a1..a866a8bfcb83 100644 --- a/lib/public_key/doc/src/public_key_app.xml +++ b/lib/public_key/doc/src/public_key_app.xml @@ -41,7 +41,7 @@ Supports RFC 5280 - Internet X.509 Public-Key Infrastructure Certificate and Certificate Revocation List - (CRL) Profile. Certificate policies are currently not supported. + (CRL) Profile. Certificate policies supported since OTP-26.2 Supports PKCS-1 - RSA Cryptography Standard Supports DSS - diff --git a/lib/public_key/include/public_key.hrl b/lib/public_key/include/public_key.hrl index 236cfa071bbb..1ebe541e3a51 100644 --- a/lib/public_key/include/public_key.hrl +++ b/lib/public_key/include/public_key.hrl @@ -41,47 +41,51 @@ {valid, UserState} end, []}). --record(path_validation_state, { - valid_policy_tree, - explicit_policy, - inhibit_any_policy, - policy_mapping, - cert_num, - last_cert = false, - permitted_subtrees = no_constraints, %% Name constraints - excluded_subtrees = [], %% Name constraints - working_public_key_algorithm, - working_public_key, - working_public_key_parameters, - working_issuer_name, - max_path_length, - verify_fun, - user_state - }). +-record(path_validation_state, + { + valid_policy_tree, + user_initial_policy_set, + explicit_policy, + inhibit_any_policy, + inhibit_policy_mapping, + policy_mapping_ext, + policy_constraint_ext, + policy_inhibitany_ext, + policy_ext_present, + policy_ext_any, + current_any_policy_qualifiers, + cert_num, + last_cert = false, + permitted_subtrees = no_constraints, %% Name constraints + excluded_subtrees = [], %% Name constraints + working_public_key_algorithm, + working_public_key, + working_public_key_parameters, + working_issuer_name, + max_path_length, + verify_fun, + user_state + }). --record(policy_tree_node, { - valid_policy, - qualifier_set, - criticality_indicator, - expected_policy_set - }). +-record(revoke_state, + { + reasons_mask, + cert_status, + interim_reasons_mask, + valid_ext, + details + }). --record(revoke_state, { - reasons_mask, - cert_status, - interim_reasons_mask, - valid_ext, - details - }). +-record('ECPoint', + { + point + }). --record('ECPoint', { - point - }). - --record(cert, { - der :: public_key:der_encoded(), - otp :: #'OTPCertificate'{} - }). +-record(cert, + { + der :: public_key:der_encoded(), + otp :: #'OTPCertificate'{} + }). -define(unspecified, 0). -define(keyCompromise, 1). diff --git a/lib/public_key/src/Makefile b/lib/public_key/src/Makefile index 9b2b4427946f..a2444c64d80b 100644 --- a/lib/public_key/src/Makefile +++ b/lib/public_key/src/Makefile @@ -45,6 +45,7 @@ MODULES = \ pubkey_ssh \ pubkey_pbe \ pubkey_cert \ + pubkey_policy_tree \ pubkey_cert_records \ pubkey_crl\ pubkey_ocsp \ diff --git a/lib/public_key/src/pubkey_cert.erl b/lib/public_key/src/pubkey_cert.erl index be9a5969069b..cd8102cb6a61 100644 --- a/lib/public_key/src/pubkey_cert.erl +++ b/lib/public_key/src/pubkey_cert.erl @@ -18,34 +18,38 @@ %% %CopyrightEnd% %% -%% - -module(pubkey_cert). -include("public_key.hrl"). --export([init_validation_state/3, - prepare_for_next_cert/2, - validate_time/3, - validate_signature/6, - validate_issuer/4, +%% path validation +-export([init_validation_state/3, + validate_extensions/4, + validate_time/3, + validate_issuer/4, validate_names/6, - validate_extensions/4, - normalize_general_name/1, + validate_signature/6, + verify_data/1, + verify_fun/4, + prepare_for_next_cert/2]). + +%% Utility functions +-export([normalize_general_name/1, is_self_signed/1, - is_issuer/2, + is_issuer/2, issuer_id/2, subject_id/1, - distribution_points/1, - is_fixed_dh_cert/1, - verify_data/1, - verify_fun/4, - select_extension/2, + distribution_points/1, + is_fixed_dh_cert/1, + select_extension/2, match_name/3, - extensions_list/1, - cert_auth_key_id/1, - time_str_2_gregorian_sec/1, - gen_test_certs/1, + extensions_list/1, + cert_auth_key_id/1, + time_str_2_gregorian_sec/1 + ]). + +%% Generate test data +-export([gen_test_certs/1, x509_pkix_sign_types/1, root_cert/2]). @@ -55,18 +59,9 @@ %% Internal application APIs %%==================================================================== -%%-------------------------------------------------------------------- --spec verify_data(DER::binary()) -> - {DigestType, PlainText, Signature} - when DigestType :: md5 | crypto:sha1() | crypto:sha2() | none, - PlainText :: binary(), - Signature :: binary(). -%% -%% Description: Extracts data from DerCert needed to call public_key:verify/4. -%%-------------------------------------------------------------------- -verify_data(DerCert) -> - {ok, OtpCert} = pubkey_cert_records:decode_cert(DerCert), - extract_verify_data(OtpCert, DerCert). +%%==================================================================== +%% Path validation +%%==================================================================== %%-------------------------------------------------------------------- -spec init_validation_state(#'OTPCertificate'{}, integer(), list()) -> @@ -74,74 +69,86 @@ verify_data(DerCert) -> %% %% Description: Creates initial version of path_validation_state for %% basic path validation of x509 certificates. -%%-------------------------------------------------------------------- -init_validation_state(#'OTPCertificate'{} = OtpCert, DefaultPathLen, +%%-------------------------------------------------------------------- +init_validation_state(#'OTPCertificate'{} = OtpCert, DefaultPathLen, Options) -> - PolicyTree = #policy_tree_node{valid_policy = ?anyPolicy, - qualifier_set = [], - criticality_indicator = false, - expected_policy_set = [?anyPolicy]}, + PolicyTree = pubkey_policy_tree:root(), MaxLen = proplists:get_value(max_path_length, Options, DefaultPathLen), - ExplicitPolicy = policy_indicator(MaxLen, - proplists:get_value(explicit_policy, Options, false)), - InhibitAnyPolicy = policy_indicator(MaxLen, - proplists:get_value(inhibit_any_policy, - Options, false)), - PolicyMapping = policy_indicator(MaxLen, - proplists:get_value(policy_mapping, Options, false)), - {VerifyFun, UserState} = proplists:get_value(verify_fun, Options, ?DEFAULT_VERIFYFUN), - State = #path_validation_state{max_path_length = MaxLen, - valid_policy_tree = PolicyTree, - explicit_policy = ExplicitPolicy, - inhibit_any_policy = InhibitAnyPolicy, - policy_mapping = PolicyMapping, - verify_fun = VerifyFun, - user_state = UserState, - cert_num = 0}, + UserPolicySet = policy_set(Options, [?anyPolicy]), + ExplicitPolicyConstraint = + policy_indicator(MaxLen, + proplists:get_value(explicit_policy, Options, false)), + AnyPolicyConstraint = + policy_indicator(MaxLen, + proplists:get_value(inhibit_any_policy, Options, false)), + PolicyMappingConstraint = + policy_indicator(MaxLen, + proplists:get_value(inhibit_policy_mapping, Options, false)), + {VerifyFun, UserState} = proplists:get_value(verify_fun, Options, + ?DEFAULT_VERIFYFUN), + State = #path_validation_state{max_path_length = MaxLen, + user_initial_policy_set = UserPolicySet, + valid_policy_tree = PolicyTree, + explicit_policy = ExplicitPolicyConstraint, + inhibit_any_policy = AnyPolicyConstraint, + inhibit_policy_mapping = PolicyMappingConstraint, + verify_fun = VerifyFun, + user_state = UserState, + cert_num = 0}, prepare_for_next_cert(OtpCert, State). %%-------------------------------------------------------------------- --spec prepare_for_next_cert(#'OTPCertificate'{}, #path_validation_state{}) -> - #path_validation_state{}. +-spec validate_extensions(#'OTPCertificate'{}, #path_validation_state{}, + term(), fun())-> + {#path_validation_state{}, UserState :: term()}. %% -%% Description: Update path_validation_state for next iteration. -%%-------------------------------------------------------------------- -prepare_for_next_cert(OtpCert, ValidationState = #path_validation_state{ - working_public_key_algorithm = PrevAlgo, - working_public_key_parameters = - PrevParams}) -> - TBSCert = OtpCert#'OTPCertificate'.tbsCertificate, - Issuer = TBSCert#'OTPTBSCertificate'.subject, - - {Algorithm, PublicKey, PublicKeyParams0} = - public_key_info(TBSCert#'OTPTBSCertificate'.subjectPublicKeyInfo, - ValidationState), - PublicKeyParams = - case PublicKeyParams0 of - 'NULL' when Algorithm =:= PrevAlgo -> - PrevParams; - asn1_NOVALUE when Algorithm =:= PrevAlgo -> - PrevParams; - _ -> PublicKeyParams0 - end, - - ValidationState#path_validation_state{ - working_public_key_algorithm = Algorithm, - working_public_key = PublicKey, - working_public_key_parameters = PublicKeyParams, - working_issuer_name = Issuer, - cert_num = ValidationState#path_validation_state.cert_num + 1 - }. - - %%-------------------------------------------------------------------- --spec validate_time(#'OTPCertificate'{}, term(), fun()) -> term() | no_return(). +%% Description: Check extensions included in basic path validation. +%%-------------------------------------------------------------------- +validate_extensions(OtpCert, ValidationState0, UserState0, VerifyFun) -> + TBSCert = OtpCert#'OTPCertificate'.tbsCertificate, + case TBSCert#'OTPTBSCertificate'.version of + N when N >= 3 -> + Extensions = TBSCert#'OTPTBSCertificate'.extensions, + validate_extensions(OtpCert, Extensions, + ValidationState0, no_basic_constraint, + is_self_signed(OtpCert), UserState0, VerifyFun); + _ -> %% Extensions not present in versions 1 & 2 + {ValidationState0, UserState0} + end. +%%-------------------------------------------------------------------- +-spec validate_policy_tree(#'OTPCertificate'{}, #path_validation_state{})-> + #path_validation_state{} | no_return(). +%% +%% Description: Check policy tree requirements after handling of certificate extensions +%%-------------------------------------------------------------------- +validate_policy_tree(OtpCert, + #path_validation_state{explicit_policy = ExplicitPolicyConstraint, + valid_policy_tree = Tree, + user_state = UserState0, + verify_fun = VerifyFun} = + ValidationState) -> + case (ExplicitPolicyConstraint > 0) orelse not pubkey_policy_tree:is_empty(Tree) of + true -> + ValidationState; + false -> + UserState = + verify_fun(OtpCert, {bad_cert, + {policy_requirement_not_met, + {{explicit_policy, ExplicitPolicyConstraint}, + {policy_set, pubkey_policy_tree:constrained_policy_node_set(Tree)}}}}, + UserState0, VerifyFun), + ValidationState#path_validation_state{user_state = UserState} + end. + +%%-------------------------------------------------------------------- +-spec validate_time(#'OTPCertificate'{}, term(), fun()) -> term(). %% -%% Description: Check that the certificate validity period includes the +%% Description: Check that the certificate validity period includes the %% current time. -%%-------------------------------------------------------------------- +%%-------------------------------------------------------------------- validate_time(OtpCert, UserState, VerifyFun) -> TBSCert = OtpCert#'OTPCertificate'.tbsCertificate, - {'Validity', NotBeforeStr, NotAfterStr} + {'Validity', NotBeforeStr, NotAfterStr} = TBSCert#'OTPTBSCertificate'.validity, Now = calendar:datetime_to_gregorian_seconds(calendar:universal_time()), NotBefore = time_str_2_gregorian_sec(notBefore, NotBeforeStr), @@ -158,7 +165,7 @@ validate_time(OtpCert, UserState, VerifyFun) -> %% %% Description: Check that the certificate issuer name is the working_issuer_name %% in path_validation_state. -%%-------------------------------------------------------------------- +%%-------------------------------------------------------------------- validate_issuer(OtpCert, Issuer, UserState, VerifyFun) -> TBSCert = OtpCert#'OTPCertificate'.tbsCertificate, case is_issuer(Issuer, TBSCert#'OTPTBSCertificate'.issuer) of @@ -166,54 +173,36 @@ validate_issuer(OtpCert, Issuer, UserState, VerifyFun) -> UserState; _ -> verify_fun(OtpCert, {bad_cert, invalid_issuer}, UserState, VerifyFun) - end. -%%-------------------------------------------------------------------- --spec validate_signature(#'OTPCertificate'{}, DER::binary(), - term(),term(), term(), fun()) -> term() | no_return(). - -%% -%% Description: Check that the signature on the certificate can be verified using -%% working_public_key_algorithm, the working_public_key, and -%% the working_public_key_parameters in path_validation_state. -%%-------------------------------------------------------------------- -validate_signature(OtpCert, DerCert, Key, KeyParams, - UserState, VerifyFun) -> - - case verify_signature(OtpCert, DerCert, Key, KeyParams) of - true -> - UserState; - false -> - verify_fun(OtpCert, {bad_cert, invalid_signature}, UserState, VerifyFun) end. %%-------------------------------------------------------------------- -spec validate_names(#'OTPCertificate'{}, no_constraints | list(), list(), term(), term(), fun())-> term() | no_return(). %% %% Description: Validate Subject Alternative Name. -%%-------------------------------------------------------------------- +%%-------------------------------------------------------------------- validate_names(OtpCert, Permit, Exclude, Last, UserState, VerifyFun) -> case is_self_signed(OtpCert) andalso (not Last) of - true -> + true -> UserState; false -> - TBSCert = OtpCert#'OTPCertificate'.tbsCertificate, + TBSCert = OtpCert#'OTPCertificate'.tbsCertificate, Subject = TBSCert#'OTPTBSCertificate'.subject, - Extensions = + Extensions = extensions_list(TBSCert#'OTPTBSCertificate'.extensions), - AltSubject = + AltSubject = select_extension(?'id-ce-subjectAltName', Extensions), - + EmailAddress = extract_email(Subject), Name = [{directoryName, Subject}|EmailAddress], - + AltNames = case AltSubject of - undefined -> + undefined -> []; - _ -> + _ -> AltSubject#'Extension'.extnValue end, - - case (is_permitted(Name, Permit) andalso + + case (is_permitted(Name, Permit) andalso is_permitted(AltNames, Permit) andalso (not is_excluded(Name, Exclude)) andalso (not is_excluded(AltNames, Exclude))) of @@ -226,30 +215,142 @@ validate_names(OtpCert, Permit, Exclude, Last, UserState, VerifyFun) -> end. %%-------------------------------------------------------------------- --spec validate_extensions(#'OTPCertificate'{}, #path_validation_state{}, - term(), fun())-> - {#path_validation_state{}, UserState :: term()}. +-spec validate_signature(#'OTPCertificate'{}, DER::binary(), + term(),term(), term(), fun()) -> term() | no_return(). + %% -%% Description: Check extensions included in basic path validation. -%%-------------------------------------------------------------------- -validate_extensions(OtpCert, ValidationState, UserState, VerifyFun) -> - TBSCert = OtpCert#'OTPCertificate'.tbsCertificate, - case TBSCert#'OTPTBSCertificate'.version of - N when N >= 3 -> - Extensions = TBSCert#'OTPTBSCertificate'.extensions, - validate_extensions(OtpCert, Extensions, - ValidationState, no_basic_constraint, - is_self_signed(OtpCert), UserState, VerifyFun); - _ -> %% Extensions not present in versions 1 & 2 - {ValidationState, UserState} +%% Description: Check that the signature on the certificate can be verified using +%% working_public_key_algorithm, the working_public_key, and +%% the working_public_key_parameters in path_validation_state. +%%-------------------------------------------------------------------- +validate_signature(OtpCert, DerCert, Key, KeyParams, + UserState, VerifyFun) -> + + case verify_signature(OtpCert, DerCert, Key, KeyParams) of + true -> + UserState; + false -> + verify_fun(OtpCert, {bad_cert, invalid_signature}, UserState, VerifyFun) end. + +%%-------------------------------------------------------------------- +-spec verify_data(DER::binary()) -> + {DigestType, PlainText, Signature} + when DigestType :: md5 | crypto:sha1() | crypto:sha2() | none, + PlainText :: binary(), + Signature :: binary(). +%% +%% Description: Extracts data from DerCert needed to call public_key:verify/4. +%%-------------------------------------------------------------------- +verify_data(DerCert) -> + {ok, OtpCert} = pubkey_cert_records:decode_cert(DerCert), + extract_verify_data(OtpCert, DerCert). + %%-------------------------------------------------------------------- --spec normalize_general_name({rdnSequence, term()}| binary()) -> {rdnSequence, term()}. +-spec verify_fun(#'OTPCertificate'{}, {bad_cert, public_key:bad_cert_reason()} | {extension, #'Extension'{}}| + valid | valid_peer, term(), fun()) -> term() | no_return(). +%% +%% Description: Gives the user application the opportunity handle path +%% validation errors and unknown extensions and optional do other +%% things with a validated certificate. +%% -------------------------------------------------------------------- +verify_fun(Otpcert, Result, UserState0, VerifyFun) -> + case VerifyFun(Otpcert, Result, UserState0) of + {valid, UserState} -> + UserState; + {valid_peer, UserState} -> + UserState; + {fail, Reason} -> + case Reason of + {bad_cert, _} -> + throw(Reason); + _ -> + throw({bad_cert, Reason}) + end; + {unknown, UserState} -> + case Result of + {extension, #'Extension'{critical = true}} -> + throw({bad_cert, unknown_critical_extension}); + _ -> + UserState + end + end. + +%%-------------------------------------------------------------------- +-spec prepare_for_next_cert(#'OTPCertificate'{}, #path_validation_state{}) -> + #path_validation_state{} | no_return(). +%% +%% Description: Update path_validation_state for next iteration. +%%-------------------------------------------------------------------- +prepare_for_next_cert(OtpCert, #path_validation_state{policy_mapping_ext = Ext} = + ValidationState0) when Ext =/= undefined -> + ValidationState1 = handle_policy_mappings(OtpCert, ValidationState0), + ValidationState = + ValidationState1#path_validation_state{policy_mapping_ext = + undefined, + current_any_policy_qualifiers = + undefined}, + prepare_for_next_cert(OtpCert, ValidationState); +prepare_for_next_cert(OtpCert, #path_validation_state{ + working_public_key_algorithm = PrevAlgo, + working_public_key_parameters = + PrevParams, + cert_num = CertNum, + explicit_policy = ExplicitPolicyConstraint, + inhibit_policy_mapping = PolicyMappingConstraint, + inhibit_any_policy = AnyPolicyConstraint + } = ValidationState0) -> + TBSCert = OtpCert#'OTPCertificate'.tbsCertificate, + Issuer = TBSCert#'OTPTBSCertificate'.subject, + + {Algorithm, PublicKey, PublicKeyParams0} = + public_key_info(TBSCert#'OTPTBSCertificate'.subjectPublicKeyInfo, + ValidationState0), + PublicKeyParams = + case PublicKeyParams0 of + 'NULL' when Algorithm =:= PrevAlgo -> + PrevParams; + asn1_NOVALUE when Algorithm =:= PrevAlgo -> + PrevParams; + _ -> PublicKeyParams0 + end, + + IsSelfSigned = is_self_signed(OtpCert), + ValidationState1 = + ValidationState0#path_validation_state{ + working_public_key_algorithm = Algorithm, + working_public_key = PublicKey, + working_public_key_parameters = PublicKeyParams, + working_issuer_name = Issuer, + cert_num = CertNum + 1, + policy_ext_present = false, + valid_policy_tree = + assert_valid_policy_tree(ValidationState0#path_validation_state.explicit_policy, + ValidationState0#path_validation_state.policy_ext_present, + ValidationState0#path_validation_state.valid_policy_tree), + current_any_policy_qualifiers = undefined, + policy_ext_any = undefined, + + %% 6.1.4 h + explicit_policy = maybe_decrement(ExplicitPolicyConstraint, IsSelfSigned), % 1 + inhibit_policy_mapping = maybe_decrement(PolicyMappingConstraint, IsSelfSigned), % 2 + inhibit_any_policy = maybe_decrement(AnyPolicyConstraint, IsSelfSigned) % 3 + }, + ValidationState2 = handle_policy_constraints(ValidationState1), + ValidationState = handle_inhibit_anypolicy(ValidationState2), + handle_last_cert(OtpCert, ValidationState). + +%%==================================================================== +%% Utility functions +%%==================================================================== + +%%-------------------------------------------------------------------- +-spec normalize_general_name({rdnSequence, term()}| binary()) -> {rdnSequence, term()}. %% %% Description: Normalizes a general name so that it can be easily -%% compared to another general name. -%%-------------------------------------------------------------------- -normalize_general_name({rdnSequence, Issuer}) -> +%% compared to another general name. +%%-------------------------------------------------------------------- +normalize_general_name({rdnSequence, Issuer}) -> NormIssuer = do_normalize_general_name(Issuer), {rdnSequence, NormIssuer}. @@ -257,26 +358,26 @@ normalize_general_name({rdnSequence, Issuer}) -> -spec is_self_signed(#'OTPCertificate'{}) -> boolean(). %% %% Description: Checks if the certificate is self signed. -%%-------------------------------------------------------------------- +%%-------------------------------------------------------------------- is_self_signed(#'OTPCertificate'{tbsCertificate= - #'OTPTBSCertificate'{issuer = Issuer, + #'OTPTBSCertificate'{issuer = Issuer, subject = Subject}}) -> is_issuer(Issuer, Subject). %%-------------------------------------------------------------------- --spec is_issuer({rdnSequence, term()}, {rdnSequence, term()}) -> boolean(). +-spec is_issuer({rdnSequence, term()}, {rdnSequence, term()}) -> boolean(). %% %% Description: Checks if issued . -%%-------------------------------------------------------------------- +%%-------------------------------------------------------------------- is_issuer({rdnSequence, _} = Issuer, {rdnSequence, _} = Candidate) -> {rdnSequence, IssuerDirName} = normalize_general_name(Issuer), {rdnSequence, CandidateDirName} = normalize_general_name(Candidate), is_dir_name(IssuerDirName, CandidateDirName, true). %%-------------------------------------------------------------------- --spec issuer_id(#'OTPCertificate'{}, self | other) -> +-spec issuer_id(#'OTPCertificate'{}, self | other) -> {ok, {integer(), term()}} | {error, issuer_not_found}. %% %% Description: Extracts the issuer id from a certificate if possible. -%%-------------------------------------------------------------------- +%%-------------------------------------------------------------------- issuer_id(Otpcert, other) -> TBSCert = Otpcert#'OTPCertificate'.tbsCertificate, Extensions = extensions_list(TBSCert#'OTPTBSCertificate'.extensions), @@ -286,25 +387,25 @@ issuer_id(Otpcert, other) -> AuthKeyExt -> cert_auth_key_id(AuthKeyExt#'Extension'.extnValue) end; - + issuer_id(Otpcert, self) -> - TBSCert = Otpcert#'OTPCertificate'.tbsCertificate, + TBSCert = Otpcert#'OTPCertificate'.tbsCertificate, Issuer = TBSCert#'OTPTBSCertificate'.issuer, SerialNr = TBSCert#'OTPTBSCertificate'.serialNumber, - {ok, {SerialNr, normalize_general_name(Issuer)}}. + {ok, {SerialNr, normalize_general_name(Issuer)}}. %%-------------------------------------------------------------------- --spec subject_id(#'OTPCertificate'{}) -> +-spec subject_id(#'OTPCertificate'{}) -> {integer(), term()}. %% %% Description: Extracts the subject and serial number from a certificate. %%-------------------------------------------------------------------- subject_id(Otpcert) -> - TBSCert = Otpcert#'OTPCertificate'.tbsCertificate, + TBSCert = Otpcert#'OTPCertificate'.tbsCertificate, Subject = TBSCert#'OTPTBSCertificate'.subject, SerialNr = TBSCert#'OTPTBSCertificate'.serialNumber, - {SerialNr, normalize_general_name(Subject)}. + {SerialNr, normalize_general_name(Subject)}. distribution_points(Otpcert) -> @@ -318,48 +419,18 @@ distribution_points(Otpcert) -> end. %%-------------------------------------------------------------------- --spec is_fixed_dh_cert(#'OTPCertificate'{}) -> boolean(). +-spec is_fixed_dh_cert(#'OTPCertificate'{}) -> boolean(). %% %% Description: Checks if the certificate can be be used %% for DH key agreement. -%%-------------------------------------------------------------------- +%%-------------------------------------------------------------------- is_fixed_dh_cert(#'OTPCertificate'{tbsCertificate = - #'OTPTBSCertificate'{subjectPublicKeyInfo = + #'OTPTBSCertificate'{subjectPublicKeyInfo = SubjectPublicKeyInfo, - extensions = + extensions = Extensions}}) -> - is_fixed_dh_cert(SubjectPublicKeyInfo, extensions_list(Extensions)). + is_fixed_dh_cert(SubjectPublicKeyInfo, extensions_list(Extensions)). - -%%-------------------------------------------------------------------- --spec verify_fun(#'OTPCertificate'{}, {bad_cert, atom()} | {extension, #'Extension'{}}| - valid | valid_peer, term(), fun()) -> term() | no_return(). -%% -%% Description: Gives the user application the opportunity handle path -%% validation errors and unknown extensions and optional do other -%% things with a validated certificate. -%% -------------------------------------------------------------------- -verify_fun(Otpcert, Result, UserState0, VerifyFun) -> - case VerifyFun(Otpcert, Result, UserState0) of - {valid, UserState} -> - UserState; - {valid_peer, UserState} -> - UserState; - {fail, Reason} -> - case Reason of - {bad_cert, _} -> - throw(Reason); - _ -> - throw({bad_cert, Reason}) - end; - {unknown, UserState} -> - case Result of - {extension, #'Extension'{critical = true}} -> - throw({bad_cert, unknown_critical_extension}); - _ -> - UserState - end - end. %%-------------------------------------------------------------------- -spec select_extension(Oid ::tuple(),[#'Extension'{}]) -> #'Extension'{} | undefined. @@ -379,9 +450,12 @@ select_extension(Id, [_ | Extensions]) -> select_extension(Id, Extensions). %%-------------------------------------------------------------------- -%% TODO: +-spec match_name(TYpe:: rfc822Name | directoryName | uniformResourceIdentifier | + emailAddress | dNSName | x400Address | ipAdress, + Name::term(), Names::[term()]) -> boolean(). %% -%% Description: +%% Description: Does match any of name in Names according to +%% the match rules for the Type. %%-------------------------------------------------------------------- match_name(rfc822Name, Name, [PermittedName | Rest]) -> match_name(fun is_valid_host_or_domain/2, Name, PermittedName, Rest); @@ -443,25 +517,19 @@ match_name(ipAdress, IP, [PermittedIP | Rest]) -> end, match_name(Fun, IP, PermittedIP, Rest). -match_name(Fun, Name, PermittedName, []) -> - Fun(Name, PermittedName); -match_name(Fun, Name, PermittedName, [Head | Tail]) -> - case Fun(Name, PermittedName) of - true -> - true; - false -> - match_name(Fun, Name, Head, Tail) - end. +%%==================================================================== +%% Generate test data +%%==================================================================== -%%% +%%-------------------------------------------------------------------- -spec gen_test_certs(#{server_chain:= public_key:chain_opts(), client_chain:= public_key:chain_opts()} | public_key:chain_opts()) -> public_key:test_config() | [public_key:conf_opt()]. -%% -%% Generates server and and client configuration for testing +%% Description: Generates server and and client configuration for testing %% purposes. All certificate options have default values +%%-------------------------------------------------------------------- gen_test_certs( #{client_chain := #{root := ClientRoot, @@ -521,9 +589,17 @@ gen_test_certs( DERCAs = ca_config(RootCert, CAsKeys), [{cert, DERCert}, {key, DERKey}, {cacerts, DERCAs}]. - -x509_pkix_sign_types(#'SignatureAlgorithm'{algorithm = ?'id-RSASSA-PSS', - parameters = #'RSASSA-PSS-params'{saltLength = SaltLen, hashAlgorithm = #'HashAlgorithm'{algorithm = Alg}}}) -> +%%%%-------------------------------------------------------------------- +-spec x509_pkix_sign_types(#'SignatureAlgorithm'{}) -> {Hash::atom(), Sign::atom(), + Options::list()}. +%% +%% Description: Extract signature algorithm options. +%%%%-------------------------------------------------------------------- +x509_pkix_sign_types( + #'SignatureAlgorithm'{algorithm = ?'id-RSASSA-PSS', + parameters = #'RSASSA-PSS-params'{ + saltLength = SaltLen, + hashAlgorithm = #'HashAlgorithm'{algorithm = Alg}}}) -> Hash = public_key:pkix_hash_type(Alg), {Hash, rsa_pss_pss, [{rsa_padding, rsa_pkcs1_pss_padding}, {rsa_pss_saltlen, SaltLen}, @@ -532,17 +608,18 @@ x509_pkix_sign_types(#'SignatureAlgorithm'{algorithm = Alg}) -> {Hash, Sign} = public_key:pkix_sign_types(Alg), {Hash, Sign, []}. -%%% +%%%%-------------------------------------------------------------------- -spec root_cert(string(), [public_key:cert_opt()]) -> public_key:test_root_cert(). %% -%% Generate a self-signed root cert +%% Description: Generate a self-signed root cert +%%%%-------------------------------------------------------------------- root_cert(Name, Opts) -> PrivKey = gen_key(proplists:get_value(key, Opts, default_key_gen())), TBS = cert_template(), Issuer = subject("root", Name), SignatureId = sign_algorithm(PrivKey, Opts), SPI = public_key(PrivKey, SignatureId), - + OTPTBS = TBS#'OTPTBSCertificate'{ signature = SignatureId, @@ -558,82 +635,579 @@ root_cert(Name, Opts) -> %%-------------------------------------------------------------------- %%% Internal functions %%-------------------------------------------------------------------- -do_normalize_general_name(Issuer) -> - Normalize = fun([{Description, Type, {printableString, Value}}]) -> - NewValue = string:casefold(strip_spaces(Value, false)), - [{Description, Type, {printableString, NewValue}}]; - (Atter) -> - Atter - end, - lists:map(Normalize, Issuer). -%% See rfc3280 4.1.2.6 Subject: regarding emails. -extract_email({rdnSequence, List}) -> - extract_email2(List). -extract_email2([[#'AttributeTypeAndValue'{type=?'id-emailAddress', - value=Mail}]|_]) -> - [{rfc822Name, Mail}]; -extract_email2([_|Rest]) -> - extract_email2(Rest); -extract_email2([]) -> []. +%% No extensions present +validate_extensions(OtpCert, asn1_NOVALUE, ValidationState, ExistBasicCon, + SelfSigned, UserState, VerifyFun) -> + validate_extensions(OtpCert, [], ValidationState, ExistBasicCon, + SelfSigned, UserState, VerifyFun); -extensions_list(asn1_NOVALUE) -> - []; -extensions_list(Extensions) -> - Extensions. +validate_extensions(_,[], ValidationState, basic_constraint, _SelfSigned, + UserState, _) -> + {ValidationState, UserState}; +validate_extensions(OtpCert, [], ValidationState = + #path_validation_state{max_path_length = Len, + last_cert = Last}, + no_basic_constraint, SelfSigned, UserState0, VerifyFun) -> + case Last of + true when SelfSigned -> + {ValidationState, UserState0}; + true -> + {ValidationState#path_validation_state{max_path_length = Len - 1}, + UserState0}; + false -> + %% basic_constraint must appear in certs used for digital sign + %% see 4.2.1.10 in rfc 3280 + case is_digitally_sign_cert(OtpCert) of + true -> + missing_basic_constraints(OtpCert, SelfSigned, + ValidationState, VerifyFun, + UserState0, Len); + false -> %% Example CRL signer only + {ValidationState, UserState0} + end + end; -extract_verify_data(OtpCert, DerCert) -> - Signature = OtpCert#'OTPCertificate'.signature, - SigAlg = OtpCert#'OTPCertificate'.signatureAlgorithm, - PlainText = encoded_tbs_cert(DerCert), - {DigestType,_,_} = x509_pkix_sign_types(SigAlg), - {DigestType, PlainText, Signature}. +validate_extensions(OtpCert, + [#'Extension'{extnID = ?'id-ce-basicConstraints', + extnValue = + #'BasicConstraints'{cA = true, + pathLenConstraint = N}} | + Rest], + ValidationState = + #path_validation_state{max_path_length = Len}, _, + SelfSigned, UserState, VerifyFun) -> + Length = if SelfSigned -> erlang:min(N, Len); + true -> erlang:min(N, Len-1) + end, + validate_extensions(OtpCert, Rest, + ValidationState#path_validation_state{max_path_length = + Length}, + basic_constraint, SelfSigned, + UserState, VerifyFun); +%% The pathLenConstraint field is meaningful only if cA is set to +%% TRUE. +validate_extensions(OtpCert, [#'Extension'{extnID = ?'id-ce-basicConstraints', + extnValue = + #'BasicConstraints'{cA = false}} | + Rest], ValidationState, ExistBasicCon, + SelfSigned, UserState, VerifyFun) -> + validate_extensions(OtpCert, Rest, ValidationState, ExistBasicCon, + SelfSigned, UserState, VerifyFun); -verify_signature(OtpCert, DerCert, Key, KeyParams) -> - {DigestType, PlainText, Signature} = extract_verify_data(OtpCert, DerCert), - case Key of - #'RSAPublicKey'{} -> - case KeyParams of - #'RSASSA-PSS-params'{} -> - public_key:verify(PlainText, DigestType, Signature, Key, verify_options(KeyParams)); - 'NULL' -> - public_key:verify(PlainText, DigestType, Signature, Key) - end; - _ -> - public_key:verify(PlainText, DigestType, Signature, {Key, KeyParams}) +validate_extensions(OtpCert, [#'Extension'{extnID = ?'id-ce-keyUsage', + extnValue = KeyUse + } | Rest], + #path_validation_state{last_cert=Last} = ValidationState, + ExistBasicCon, SelfSigned, + UserState0, VerifyFun) -> + case Last orelse is_valid_key_usage(KeyUse, keyCertSign) of + true -> + validate_extensions(OtpCert, Rest, ValidationState, ExistBasicCon, + SelfSigned, UserState0, VerifyFun); + false -> + UserState = verify_fun(OtpCert, {bad_cert, invalid_key_usage}, + UserState0, VerifyFun), + validate_extensions(OtpCert, Rest, ValidationState, ExistBasicCon, + SelfSigned, UserState, VerifyFun) + end; + +validate_extensions(OtpCert, [#'Extension'{extnID = ?'id-ce-subjectAltName', + extnValue = Names, + critical = true} = Ext | Rest], + ValidationState, ExistBasicCon, + SelfSigned, UserState0, VerifyFun) -> + case validate_subject_alt_names(Names) of + true -> + validate_extensions(OtpCert, Rest, ValidationState, ExistBasicCon, + SelfSigned, UserState0, VerifyFun); + false -> + UserState = verify_fun(OtpCert, {extension, Ext}, + UserState0, VerifyFun), + validate_extensions(OtpCert, Rest, ValidationState, ExistBasicCon, + SelfSigned, UserState, VerifyFun) + end; + +validate_extensions(OtpCert, [#'Extension'{extnID = ?'id-ce-nameConstraints', + extnValue = NameConst} | Rest], + ValidationState, + ExistBasicCon, SelfSigned, UserState, VerifyFun) -> + Permitted = NameConst#'NameConstraints'.permittedSubtrees, + Excluded = NameConst#'NameConstraints'.excludedSubtrees, + + NewValidationState = add_name_constraints(Permitted, Excluded, + ValidationState), + + validate_extensions(OtpCert, Rest, NewValidationState, ExistBasicCon, + SelfSigned, UserState, VerifyFun); +validate_extensions(OtpCert, [#'Extension'{extnID = ?'id-ce-certificatePolicies', + extnValue = Info} + | Rest], + ValidationState, + ExistBasicCon, SelfSigned, UserState, VerifyFun) -> + Tree = process_policy_tree(Info, SelfSigned, ValidationState), + validate_extensions(OtpCert, Rest, + ValidationState#path_validation_state{ + policy_ext_present = true, + current_any_policy_qualifiers = + current_any_policy_qualifiers(Info), + valid_policy_tree = Tree}, + ExistBasicCon, SelfSigned, UserState, VerifyFun); +validate_extensions(OtpCert, [#'Extension'{extnID = ?'id-ce-policyConstraints'} = Ext + | Rest], ValidationState, ExistBasicCon, + SelfSigned, UserState, VerifyFun) -> + NewValidationState = ValidationState#path_validation_state{policy_constraint_ext = Ext}, + validate_extensions(OtpCert, Rest, NewValidationState, ExistBasicCon, + SelfSigned, UserState, VerifyFun); +validate_extensions(OtpCert, [#'Extension'{extnID = ?'id-ce-policyMappings'} = Ext + | Rest], ValidationState, ExistBasicCon, + SelfSigned, UserState, VerifyFun) -> + NewValidationState = ValidationState#path_validation_state{policy_mapping_ext = Ext}, + validate_extensions(OtpCert, Rest, NewValidationState, ExistBasicCon, + SelfSigned, UserState, VerifyFun); +validate_extensions(OtpCert, [#'Extension'{extnID = ?'id-ce-inhibitAnyPolicy'} = Ext + | Rest], ValidationState, ExistBasicCon, + SelfSigned, UserState, VerifyFun) -> + NewValidationState = ValidationState#path_validation_state{policy_inhibitany_ext = Ext}, + validate_extensions(OtpCert, Rest, NewValidationState, ExistBasicCon, + SelfSigned, UserState, VerifyFun); + +validate_extensions(OtpCert, [#'Extension'{} = Extension | Rest], + ValidationState, ExistBasicCon, + SelfSigned, UserState0, VerifyFun) -> + UserState = verify_fun(OtpCert, {extension, Extension}, UserState0, VerifyFun), + validate_extensions(OtpCert, Rest, ValidationState, ExistBasicCon, SelfSigned, + UserState, VerifyFun). + +handle_last_cert(OtpCert, #path_validation_state{last_cert = true, + cert_num = CertNum, + user_initial_policy_set = PolicySet, + valid_policy_tree = Tree} = ValidationState0) -> + TBSCert = OtpCert#'OTPCertificate'.tbsCertificate, + Extensions = + extensions_list(TBSCert#'OTPTBSCertificate'.extensions), + %% 6.5.1 b + ValidationState = + case select_extension(?'id-ce-policyConstraints', Extensions) of + undefined -> + ValidationState0; + #'Extension'{extnValue = #'PolicyConstraints'{requireExplicitPolicy = 0}} -> + ValidationState0#path_validation_state{explicit_policy = 0}; + _ -> + ValidationState0 + end, + PolicyLevel = CertNum-2, %% Cert num was alreday bumped and root level is 0 + ValidTree = policy_tree_intersection(PolicySet, Tree, PolicyLevel), + validate_policy_tree(OtpCert, + ValidationState#path_validation_state{valid_policy_tree = ValidTree}); +handle_last_cert(_, ValidationState) -> + ValidationState. + + +%%==================================================================== +%% Policy handling +%%==================================================================== +%% Start initialization RFC 5280 Section 6.1.2 ---------------------- + +%% 6.1.2 d, e, f: If is set, then the initial value +%% is 0, otherwise the initial value is n+1. (N = max path length) +policy_indicator(_, true) -> + 0; +policy_indicator(N, false) -> + N + 1. + +policy_set(Opts, Default) -> + case proplists:get_value(policy_set, Opts, undefined) of + undefined -> + Default; + Set -> + [oidify(OidStr) || OidStr <- Set] end. -encoded_tbs_cert(Cert) -> - {ok, PKIXCert} = - 'OTP-PUB-KEY':decode_TBSCert_exclusive(Cert), - {'Certificate', - {'Certificate_tbsCertificate', EncodedTBSCert}, _, _} = PKIXCert, - EncodedTBSCert. +oidify(Oid) when is_tuple(Oid) -> + Oid; +oidify(Oid) when is_list(Oid) -> + Tokens = string:tokens(Oid, "$."), + OidList = [list_to_integer(StrInt) || StrInt <- Tokens], + list_to_tuple(OidList). -public_key_info(PublicKeyInfo, - #path_validation_state{working_public_key_algorithm = - WorkingAlgorithm, - working_public_key_parameters = - WorkingParams}) -> - PublicKey = PublicKeyInfo#'OTPSubjectPublicKeyInfo'.subjectPublicKey, - AlgInfo = PublicKeyInfo#'OTPSubjectPublicKeyInfo'.algorithm, +%% End initialization ---------------------------------------------------------- + +%% Start Basic Policy Processing RFC 5280 Section 6.1.3 ----------------------- + +%% 6.1.3 f +assert_valid_policy_tree(0, PresentPolicyExtension, Tree) -> + assert_valid_policy_tree(PresentPolicyExtension, Tree); +assert_valid_policy_tree(_, _, Tree) -> + Tree. + +assert_valid_policy_tree(undefined, Tree) -> + Tree; %% Initial tree +assert_valid_policy_tree(true, Tree) -> + Tree; %% Policy extension present in step n +assert_valid_policy_tree(false, _Tree) -> % 6.1.3 e + %% Policy extension missing in step n, tree becomes empty + pubkey_policy_tree:empty(). + + +%% 6.1.3 d: If the certificate policies extension is present in the +%% certificate and the valid_policy_tree is not NULL, process the +%% policy information by performing the following steps in order: + +%% (1) For each policy P not equal to anyPolicy in the certificate +%% policies extension, let P-OID denote the OID for policy P and P-Q +%% denote the qualifier set for policy P. Perform the following +%% steps in order: + +%% (i) For each node of depth i-1 in the valid_policy_tree where +%% P-OID is in the expected_policy_set, create a child node as +%% follows: set the valid_policy to P-OID, set the qualifier_set to +%% P-Q, and set the expected_policy_set to {P-OID}. + +%% (ii) If there was no match in step (i) and the valid_policy_tree +%% includes a node of depth i-1 with the valid_policy anyPolicy, +%% generate a child node with the following values: set the +%% valid_policy to P-OID, set the qualifier_set to P-Q, and set the +%% expected_policy_set to {P-OID}. + +%% (2) If the certificate policies extension includes the policy +%% anyPolicy with the qualifier set AP-Q and either + +%% (a) inhibit_anyPolicy is greater than 0 or (b) i %% 6.1.3 e + pubkey_policy_tree:empty(); +process_policy_tree(PolicyInformation, SelfSigned, + #path_validation_state{valid_policy_tree = Tree0} = + ValidationState) -> %% 6.1.3 d + case pubkey_policy_tree:is_empty(Tree0) of + true -> + Tree0; + false -> + Tree = add_policy_children(PolicyInformation, SelfSigned, ValidationState), + pubkey_policy_tree:prune_tree(Tree) + end. + +add_policy_children(PolicyInfoList0, SelfSigned, + #path_validation_state{valid_policy_tree = Tree, + inhibit_any_policy = AnyPolicyConstraint, + cert_num = CertNum, + max_path_length = PathLen + }) -> + {AnyExt, PolicyInfoList} = + case lists:keytake(?anyPolicy, + #'PolicyInformation'.policyIdentifier, PolicyInfoList0) of + {value, AnyExt0, PolicyInfoList1} -> + {AnyExt0, PolicyInfoList1}; + false -> + {undefined, PolicyInfoList0} + end, - PublicKeyParams = AlgInfo#'PublicKeyAlgorithm'.parameters, - Algorithm = AlgInfo#'PublicKeyAlgorithm'.algorithm, + LeafFun = + fun(#{expected_policy_set := ExpPolicySet, + valid_policy := ValidPolicy}) -> + PolicyChildren = policy_children(ExpPolicySet, PolicyInfoList), + case AnyPolicyConstraint > 0 orelse + ((CertNum < PathLen) andalso SelfSigned) of + true -> + PolicyChildren ++ any_policy_children(AnyExt, ValidPolicy, + ExpPolicySet, PolicyChildren); + false -> + PolicyChildren + end + end, + pubkey_policy_tree:add_leaves(Tree, LeafFun). + +policy_children(ExpPolicySet, PolicyInfoList) -> + lists:foldl(fun(#'PolicyInformation'{ + policyIdentifier = Policy, + policyQualifiers = Qualifiers + }, Acc0 + ) -> + case lists:member(Policy, ExpPolicySet) + orelse ExpPolicySet == [?anyPolicy] of + true -> + [pubkey_policy_tree:policy_node(Policy, Qualifiers, [Policy]) | Acc0]; + false -> + Acc0 + end + end, [], PolicyInfoList). + +any_policy_children(undefined, _,_, _) -> + []; +any_policy_children(#'PolicyInformation'{ + policyIdentifier = ?anyPolicy, + policyQualifiers = Qualifiers}, ValidPolicy, + ExpPolicySet, Children) -> + [pubkey_policy_tree:policy_node(Policy, Qualifiers, [ValidPolicy]) + || Policy <- ExpPolicySet, not pubkey_policy_tree:in_set(Policy, Children)]. + +%% End Basic Policy Processing ------------------------------------------------- + +%% Start Prepare Next Cert Policy Handling RFC 5280 Section 6.1.4 ------------- + +%% 6.1.4. b start: +handle_policy_mappings(OtpCert, + #path_validation_state{valid_policy_tree = Tree0, + policy_mapping_ext = + #'Extension'{extnID = ?'id-ce-policyMappings', + extnValue = PolicyMappings}} + = ValidationState) -> + case handle_policy_mappings(PolicyMappings, OtpCert, Tree0, ValidationState) of + {tree, Tree} -> + ValidationState#path_validation_state{valid_policy_tree = Tree}; + {user_state, UState} -> + ValidationState#path_validation_state{user_state = UState} + end. + +handle_policy_mappings([], _, Tree, _) -> + {tree, Tree}; +handle_policy_mappings([Mappings | Rest], OtpCert, Tree0, ValidationState) -> + case handle_policy_mapping(Mappings, OtpCert, Tree0, ValidationState) of + {tree, Tree} -> + handle_policy_mappings(Rest, OtpCert, Tree, ValidationState); + Other -> + Other + end. + +%% 6.1.4. a: If a policy mappings extension is present, verify that the +%% special value anyPolicy does not appear as an issuerDomainPolicy or +%% a subjectDomainPolicy. +handle_policy_mapping(#'PolicyMappings_SEQOF'{ + issuerDomainPolicy = + IssuerPolicy, + subjectDomainPolicy = + SubjectPolicy} = Ext, + OtpCert, Tree0, + #path_validation_state{inhibit_policy_mapping = + PolicyMappingConstraint, + current_any_policy_qualifiers = + AnyQualifiers, + verify_fun = VerifyFun, + user_state = UserState} + ) -> + case not (?anyPolicy == IssuerPolicy) andalso + not (?anyPolicy == SubjectPolicy) of + true -> + Tree = handle_policy_mapping_ext(Ext, Tree0, + PolicyMappingConstraint, AnyQualifiers), + {tree, Tree}; + false -> + UserState = verify_fun(OtpCert, {bad_cert, {invalid_policy_mapping, Ext}}, + UserState, VerifyFun), + {user_state, UserState} + end. + +%% 6.1.4. b continue: +handle_policy_mapping_ext(#'PolicyMappings_SEQOF'{ + issuerDomainPolicy = + IssuerPolicy}, + Tree0, 0, _) -> %% 6.1.4. b 2: + %% (2) If the policy_mapping variable is equal to 0: + + %% (i) delete each node of depth i in the valid_policy_tree where + %% ID-P is the valid_policy. + %% + %% (ii) If there is a node in the valid_policy_tree of depth i-1 + %% or less without any child nodes, delete that node. Repeat this + %% step until there are no nodes of depth i-1 or less without + %% children. + + Tree = pubkey_policy_tree:prune_leaves(Tree0, IssuerPolicy), + pubkey_policy_tree:prune_tree(Tree); +handle_policy_mapping_ext(#'PolicyMappings_SEQOF'{ + issuerDomainPolicy = IssuerPolicy, + subjectDomainPolicy = SubjectPolicy}, + Tree, N, AnyQualifiers) when N > 0 -> %% 6.1.4. b 1: + %% (1) If the policy_mapping variable is greater than 0, for each + %% node in the valid_policy_tree of depth i where ID-P is the + %% valid_policy, set expected_policy_set to the set of + %% subjectDomainPolicy values that are specified as equivalent to + %% ID-P by the policy mappings extension. + + %% If no node of depth i in the valid_policy_tree has a + %% valid_policy of ID-P but there is a node of depth i with a + %% valid_policy of anyPolicy, then generate a child node of the + %% node of depth i-1 that has a valid_policy of anyPolicy as + %% follows: + + %% (i) set the valid_policy to ID-P; + + %% (ii) set the qualifier_set to the qualifier set of the policy + %% anyPolicy in the certificate policies extension of certificate + %% i; and + + %% (iii) set the expected_policy_set to the set of + %% subjectDomainPolicy values that are specified as equivalent to + %% ID-P by the policy mappings extension. + + MapPolicy = + fun(#{valid_policy := ValidPolicy, expected_policy_set := Set} = Node) + when ValidPolicy == IssuerPolicy -> + case Set == [ValidPolicy] of + true -> + Node#{expected_policy_set => [SubjectPolicy]}; + false -> + Node#{expected_policy_set => Set ++ [SubjectPolicy]} + end; + (Node) -> + Node + end, - NewPublicKeyParams = - case PublicKeyParams of - {null, 'NULL'} when WorkingAlgorithm == Algorithm -> - WorkingParams; - asn1_NOVALUE when Algorithm == ?'id-Ed25519'; - Algorithm == ?'id-Ed448' -> - {namedCurve, Algorithm}; - {params, Params} -> - Params; - Params -> - Params - end, - {Algorithm, PublicKey, NewPublicKeyParams}. + AnySiblings = fun(#{valid_policy := ?anyPolicy}) -> + [pubkey_policy_tree:policy_node(IssuerPolicy, + AnyQualifiers, + [SubjectPolicy])]; + (_) -> + no_sibling + end, + + case pubkey_policy_tree:map_leaves(Tree, MapPolicy) of + Tree -> + pubkey_policy_tree:add_siblings(Tree, AnySiblings); + NewTree -> + NewTree + end. + +%% 6.1.4 i +handle_policy_constraints(#path_validation_state{ + policy_constraint_ext = + #'Extension'{extnID = ?'id-ce-policyConstraints', + extnValue = + #'PolicyConstraints'{requireExplicitPolicy = + ExplicitPolicy, + inhibitPolicyMapping = + InhibitMapPolicy}}, + explicit_policy = CurrentExplicitPolicyConstraint, + inhibit_policy_mapping = CurrentPolicyMappingConstraint} = + ValidationState) -> + ExplicitPolicyConstraint = + policy_constraint(CurrentExplicitPolicyConstraint, ExplicitPolicy), % Step 1 + PolicyMappingConstraint = + policy_constraint(CurrentPolicyMappingConstraint, InhibitMapPolicy), % Step 2 + ValidationState#path_validation_state{explicit_policy = ExplicitPolicyConstraint, + inhibit_policy_mapping = PolicyMappingConstraint, + policy_constraint_ext = undefined}; +handle_policy_constraints(ValidationState) -> + ValidationState. + +%% 6.4.1 j +handle_inhibit_anypolicy(#path_validation_state{policy_inhibitany_ext = + #'Extension'{extnID = ?'id-ce-inhibitAnyPolicy', + extnValue = InhibitAnyPolicy + }, + inhibit_any_policy = CurrentAnyPolicy} = + ValidationState) -> + AnyPolicyConstraint = policy_constraint(CurrentAnyPolicy, InhibitAnyPolicy), + ValidationState#path_validation_state{inhibit_any_policy = AnyPolicyConstraint, + policy_inhibitany_ext = undefined}; +handle_inhibit_anypolicy(ValidationState) -> + ValidationState. + +policy_constraint(Current, asn1_NOVALUE) -> + Current; +policy_constraint(Current, New) -> + erlang:min(Current, New). + +current_any_policy_qualifiers(Info) -> + case lists:keyfind(?anyPolicy, #'PolicyInformation'.policyIdentifier, Info) of + #'PolicyInformation'{policyQualifiers = AnyQualifiers} -> + AnyQualifiers; + _ -> + [] + end. + +maybe_decrement(0, _) -> + 0; +maybe_decrement(N, false) -> + N-1; +maybe_decrement(N, true) -> + N. + +%% End Prepare Next Cert Policy Handling --------------------------------------- + +%% Start Wrap Up Policy Handling RFC 5280 Section 6.1.5 %% --------------------- + +%% Step G from RFC + +policy_tree_intersection([?anyPolicy], Tree, _) -> % (ii) from RFC + Tree; +policy_tree_intersection(UserPolicySet, Tree0, CurrentDepth) -> + case pubkey_policy_tree:is_empty(Tree0) of + true -> % (i) from RFC + Tree0; + false -> % (iii) from RFC + ValidPolicyNodeSet = pubkey_policy_tree:valid_policy_node_set(Tree0), + InvalidNodes = apply_user_constraints(ValidPolicyNodeSet, UserPolicySet), + Tree1 = pubkey_policy_tree:prune_invalid_nodes(Tree0, InvalidNodes), + Tree = handle_any_policy_leaves(Tree1, ValidPolicyNodeSet, UserPolicySet, CurrentDepth), + pubkey_policy_tree:prune_tree(Tree) + end. + +apply_user_constraints(_, [?anyPolicy]) -> + []; +apply_user_constraints(ValidPolicyNodeSet, UserPolicySet) -> + apply_user_constraints(ValidPolicyNodeSet, UserPolicySet, []). + +apply_user_constraints([], _, Acc) -> + Acc; +apply_user_constraints([#{valid_policy := ?anyPolicy} | Rest], + UserPolicySet, Acc) -> + apply_user_constraints(Rest, UserPolicySet, Acc); +apply_user_constraints([#{valid_policy := Policy} = Node | Rest], + UserPolicySet, Acc) -> + case lists:member(Policy, UserPolicySet) of + true -> + apply_user_constraints(Rest, UserPolicySet, Acc); + false -> + apply_user_constraints(Rest, UserPolicySet, [Node | Acc]) + end. + +handle_any_policy_leaves(Tree, _, [?anyPolicy], _) -> + Tree; +handle_any_policy_leaves(Tree0, ValidPolicyNodeSet, UserPolicySet, CurrentDepth) -> + case pubkey_policy_tree:any_leaves(Tree0, CurrentDepth) of + no_node -> + Tree0; + AnyLeaves -> + Tree = add_policy_nodes(AnyLeaves, Tree0, ValidPolicyNodeSet, UserPolicySet), + pubkey_policy_tree:prune_leaves(Tree, ?anyPolicy) + end. + +add_policy_nodes([], Tree, _, _) -> + Tree; +add_policy_nodes([#{qualifier_set := Qualifiers} | Rest], Tree0, ValidPolicyNodeSet, UserPolicySet) -> + PolicySet = [UPolicy || UPolicy <- UserPolicySet, + not pubkey_policy_tree:in_set(UPolicy, ValidPolicyNodeSet)], + Children = + [pubkey_policy_tree:policy_node(Policy, Qualifiers, [Policy]) || Policy <- PolicySet], + Siblings = fun(#{valid_policy := ?anyPolicy, qualifier_set := QSet}) when QSet == Qualifiers-> + Children; + (_) -> [] + end, + add_policy_nodes(Rest, pubkey_policy_tree:add_siblings(Tree0, Siblings), ValidPolicyNodeSet, UserPolicySet). + + + +%% End Wrap Up Policy Handling ------------------------------------------------- + +%%==================================================================== +%% Date handling +%%==================================================================== + %% time_str_2_gregorian_sec/2 is a wrapper (decorator pattern) over %% time_str_2_gregorian_sec/1. the decorator deals with notBefore and notAfter @@ -703,6 +1277,37 @@ mod(A, B) when A > 0 -> A rem B; mod(A, B) when A < 0 -> mod(A+B, B); mod(0, _) -> 0. +%%==================================================================== +%% Name handling +%%==================================================================== +match_name(Fun, Name, PermittedName, []) -> + Fun(Name, PermittedName); +match_name(Fun, Name, PermittedName, [Head | Tail]) -> + case Fun(Name, PermittedName) of + true -> + true; + false -> + match_name(Fun, Name, Head, Tail) + end. + +do_normalize_general_name(Issuer) -> + Normalize = fun([{Description, Type, {printableString, Value}}]) -> + NewValue = string:casefold(strip_spaces(Value, false)), + [{Description, Type, {printableString, NewValue}}]; + (Atter) -> + Atter + end, + lists:map(Normalize, Issuer). + +%% See rfc3280 4.1.2.6 Subject: regarding emails. +extract_email({rdnSequence, List}) -> + extract_email2(List). +extract_email2([[#'AttributeTypeAndValue'{type=?'id-emailAddress', + value=Mail}]|_]) -> + [{rfc822Name, Mail}]; +extract_email2([_|Rest]) -> + extract_email2(Rest); +extract_email2([]) -> []. is_dir_name([], [], _Exact) -> true; is_dir_name([H|R1],[H|R2], Exact) -> is_dir_name(R1,R2, Exact); @@ -742,20 +1347,6 @@ is_dir_name2(Str1, Str2) is_dir_name2(_, _) -> false. -cert_auth_key_id(#'AuthorityKeyIdentifier'{authorityCertIssuer - = asn1_NOVALUE}) -> - {error, issuer_not_found}; -cert_auth_key_id(#'AuthorityKeyIdentifier'{authorityCertIssuer = - AuthCertIssuer, - authorityCertSerialNumber = - SerialNr}) -> - {ok, {SerialNr, decode_general_name(AuthCertIssuer)}}. - -decode_general_name([{directoryName, Issuer}]) -> - normalize_general_name(Issuer); -decode_general_name([{_, Issuer}]) -> - Issuer. - strip_spaces(String0, KeepDeep) -> Trimmed = string:trim(String0), strip_many_spaces(string:split(Trimmed, " ", all), KeepDeep). @@ -770,170 +1361,20 @@ strip_many_spaces(Strings, KeepDeep) -> false -> unicode:characters_to_list(DeepList) end. -%% No extensions present -validate_extensions(OtpCert, asn1_NOVALUE, ValidationState, ExistBasicCon, - SelfSigned, UserState, VerifyFun) -> - validate_extensions(OtpCert, [], ValidationState, ExistBasicCon, - SelfSigned, UserState, VerifyFun); - -validate_extensions(_,[], ValidationState, basic_constraint, _SelfSigned, - UserState, _) -> - {ValidationState, UserState}; -validate_extensions(OtpCert, [], ValidationState = - #path_validation_state{max_path_length = Len, - last_cert = Last}, - no_basic_constraint, SelfSigned, UserState0, VerifyFun) -> - case Last of - true when SelfSigned -> - {ValidationState, UserState0}; - true -> - {ValidationState#path_validation_state{max_path_length = Len - 1}, - UserState0}; - false -> - %% basic_constraint must appear in certs used for digital sign - %% see 4.2.1.10 in rfc 3280 - case is_digitally_sign_cert(OtpCert) of - true -> - missing_basic_constraints(OtpCert, SelfSigned, - ValidationState, VerifyFun, - UserState0, Len); - false -> %% Example CRL signer only - {ValidationState, UserState0} - end - end; - -validate_extensions(OtpCert, - [#'Extension'{extnID = ?'id-ce-basicConstraints', - extnValue = - #'BasicConstraints'{cA = true, - pathLenConstraint = N}} | - Rest], - ValidationState = - #path_validation_state{max_path_length = Len}, _, - SelfSigned, UserState, VerifyFun) -> - Length = if SelfSigned -> erlang:min(N, Len); - true -> erlang:min(N, Len-1) - end, - validate_extensions(OtpCert, Rest, - ValidationState#path_validation_state{max_path_length = - Length}, - basic_constraint, SelfSigned, - UserState, VerifyFun); -%% The pathLenConstraint field is meaningful only if cA is set to -%% TRUE. -validate_extensions(OtpCert, [#'Extension'{extnID = ?'id-ce-basicConstraints', - extnValue = - #'BasicConstraints'{cA = false}} | - Rest], ValidationState, ExistBasicCon, - SelfSigned, UserState, VerifyFun) -> - validate_extensions(OtpCert, Rest, ValidationState, ExistBasicCon, - SelfSigned, UserState, VerifyFun); - -validate_extensions(OtpCert, [#'Extension'{extnID = ?'id-ce-keyUsage', - extnValue = KeyUse - } | Rest], - #path_validation_state{last_cert=Last} = ValidationState, - ExistBasicCon, SelfSigned, - UserState0, VerifyFun) -> - case Last orelse is_valid_key_usage(KeyUse, keyCertSign) of - true -> - validate_extensions(OtpCert, Rest, ValidationState, ExistBasicCon, - SelfSigned, UserState0, VerifyFun); - false -> - UserState = verify_fun(OtpCert, {bad_cert, invalid_key_usage}, - UserState0, VerifyFun), - validate_extensions(OtpCert, Rest, ValidationState, ExistBasicCon, - SelfSigned, UserState, VerifyFun) - end; - -validate_extensions(OtpCert, [#'Extension'{extnID = ?'id-ce-subjectAltName', - extnValue = Names, - critical = true} = Ext | Rest], - ValidationState, ExistBasicCon, - SelfSigned, UserState0, VerifyFun) -> - case validate_subject_alt_names(Names) of - true -> - validate_extensions(OtpCert, Rest, ValidationState, ExistBasicCon, - SelfSigned, UserState0, VerifyFun); - false -> - UserState = verify_fun(OtpCert, {extension, Ext}, - UserState0, VerifyFun), - validate_extensions(OtpCert, Rest, ValidationState, ExistBasicCon, - SelfSigned, UserState, VerifyFun) - end; - -validate_extensions(OtpCert, [#'Extension'{extnID = ?'id-ce-nameConstraints', - extnValue = NameConst} | Rest], - ValidationState, - ExistBasicCon, SelfSigned, UserState, VerifyFun) -> - Permitted = NameConst#'NameConstraints'.permittedSubtrees, - Excluded = NameConst#'NameConstraints'.excludedSubtrees, - - NewValidationState = add_name_constraints(Permitted, Excluded, - ValidationState), - - validate_extensions(OtpCert, Rest, NewValidationState, ExistBasicCon, - SelfSigned, UserState, VerifyFun); - -validate_extensions(OtpCert, [#'Extension'{extnID = ?'id-ce-certificatePolicies', - critical = true} = Ext| Rest], ValidationState, - ExistBasicCon, SelfSigned, UserState0, VerifyFun) -> - %% TODO: Remove this clause when policy handling is - %% fully implemented - UserState = verify_fun(OtpCert, {extension, Ext}, - UserState0, VerifyFun), - validate_extensions(OtpCert,Rest, ValidationState, ExistBasicCon, - SelfSigned, UserState, VerifyFun); - -validate_extensions(OtpCert, [#'Extension'{extnID = ?'id-ce-certificatePolicies', - extnValue = #'PolicyInformation'{ - policyIdentifier = Id, - policyQualifiers = Qualifier}} - | Rest], #path_validation_state{valid_policy_tree = Tree} - = ValidationState, - ExistBasicCon, SelfSigned, UserState, VerifyFun) -> - - %% TODO: Policy imp incomplete - NewTree = process_policy_tree(Id, Qualifier, Tree), - - validate_extensions(OtpCert, Rest, - ValidationState#path_validation_state{ - valid_policy_tree = NewTree}, - ExistBasicCon, SelfSigned, UserState, VerifyFun); - -validate_extensions(OtpCert, [#'Extension'{extnID = ?'id-ce-policyConstraints', - critical = true} = Ext | Rest], ValidationState, - ExistBasicCon, SelfSigned, UserState0, VerifyFun) -> - %% TODO: Remove this clause when policy handling is - %% fully implemented - UserState = verify_fun(OtpCert, {extension, Ext}, - UserState0, VerifyFun), - validate_extensions(OtpCert, Rest, ValidationState, ExistBasicCon, - SelfSigned, UserState, VerifyFun); -validate_extensions(OtpCert, [#'Extension'{extnID = ?'id-ce-policyConstraints', - extnValue = #'PolicyConstraints'{ - requireExplicitPolicy = ExpPolicy, - inhibitPolicyMapping = MapPolicy}} - | Rest], ValidationState, ExistBasicCon, - SelfSigned, UserState, VerifyFun) -> - - %% TODO: Policy imp incomplete - NewValidationState = add_policy_constraints(ExpPolicy, MapPolicy, - ValidationState), - - validate_extensions(OtpCert, Rest, NewValidationState, ExistBasicCon, - SelfSigned, UserState, VerifyFun); +decode_general_name([{directoryName, Issuer}]) -> + normalize_general_name(Issuer); +decode_general_name([{_, Issuer}]) -> + Issuer. -validate_extensions(OtpCert, [#'Extension'{} = Extension | Rest], - ValidationState, ExistBasicCon, - SelfSigned, UserState0, VerifyFun) -> - UserState = verify_fun(OtpCert, {extension, Extension}, UserState0, VerifyFun), - validate_extensions(OtpCert, Rest, ValidationState, ExistBasicCon, SelfSigned, - UserState, VerifyFun). +cert_auth_key_id(#'AuthorityKeyIdentifier'{authorityCertIssuer + = asn1_NOVALUE}) -> + {error, issuer_not_found}; +cert_auth_key_id(#'AuthorityKeyIdentifier'{authorityCertIssuer = + AuthCertIssuer, + authorityCertSerialNumber = + SerialNr}) -> + {ok, {SerialNr, decode_general_name(AuthCertIssuer)}}. -is_valid_key_usage(KeyUse, Use) -> - lists:member(Use, KeyUse). - validate_subject_alt_names([]) -> false; validate_subject_alt_names([AltName | Rest]) -> @@ -945,12 +1386,12 @@ validate_subject_alt_names([AltName | Rest]) -> end. is_valid_subject_alt_name({Name, Value}) when Name == rfc822Name; - Name == dNSName -> + Name == dNSName -> case Value of "" -> false; _ -> - true + true end; is_valid_subject_alt_name({iPAdress, Addr}) -> @@ -974,7 +1415,7 @@ is_valid_subject_alt_name({otherName, #'AnotherName'{}}) -> is_valid_subject_alt_name({_, _}) -> false. -is_valid_uri(AbsURI) -> +is_valid_uri(AbsURI) -> case uri_string:normalize(AbsURI, [return_map]) of #{scheme := _} -> true; @@ -982,7 +1423,7 @@ is_valid_uri(AbsURI) -> false end. -is_rdnSeq({rdnSequence,[]}, {rdnSequence,[none]}) -> +is_rdnSeq({rdnSequence,[]}, {rdnSequence,[none]}) -> true; is_rdnSeq({rdnSequence,DirName}, {rdnSequence,Permitted}) -> is_dir_name(DirName, Permitted, false). @@ -1012,13 +1453,13 @@ is_valid_name([{Type, Name} | Rest], Constraints, Default) -> is_valid_name(Rest, Constraints,Default) end. -add_name_constraints(NewPermittedTrees, NewExcludedTrees, +add_name_constraints(NewPermittedTrees, NewExcludedTrees, #path_validation_state{ permitted_subtrees = PermittedTrees, excluded_subtrees = ExcludedTrees} = ValidationState) -> NewPermitted = subtree_intersection(NewPermittedTrees, PermittedTrees), - NewExcluded = subtree_union(NewExcludedTrees, ExcludedTrees), + NewExcluded = subtree_union(NewExcludedTrees, ExcludedTrees), ValidationState#path_validation_state{permitted_subtrees = NewPermitted, excluded_subtrees = NewExcluded}. subtree_union(asn1_NOVALUE, Trees) -> @@ -1036,27 +1477,27 @@ subtree_intersection([Tree | Trees1], Trees2) -> subtree_intersection([], TreesInt) -> TreesInt. -is_in_intersection(#'GeneralSubtree'{base = - {directoryName, {rdnSequence, Name1}}} - = Name, - [#'GeneralSubtree'{base = - {directoryName, {rdnSequence, Name2}}} +is_in_intersection(#'GeneralSubtree'{base = + {directoryName, {rdnSequence, Name1}}} + = Name, + [#'GeneralSubtree'{base = + {directoryName, {rdnSequence, Name2}}} | Trees]) -> case is_dir_name(Name1, Name2, false) of true -> [Name|Trees]; false -> - [Name#'GeneralSubtree'{base = - {directoryName, {rdnSequence,[none]}}} + [Name#'GeneralSubtree'{base = + {directoryName, {rdnSequence,[none]}}} | Trees] end; -is_in_intersection(#'GeneralSubtree'{base = {ipAdress, Ip}}, +is_in_intersection(#'GeneralSubtree'{base = {ipAdress, Ip}}, Trees = [#'GeneralSubtree'{base = {ipAdress, Ip}} | _]) -> %% BUGBUG Trees; -is_in_intersection(#'GeneralSubtree'{base = {x400Address, OrAddr1}} = Addr, - [#'GeneralSubtree'{base = {x400Address, OrAddr2}} - | Trees]) -> +is_in_intersection(#'GeneralSubtree'{base = {x400Address, OrAddr1}} = Addr, + [#'GeneralSubtree'{base = {x400Address, OrAddr2}} + | Trees]) -> case is_or_address(OrAddr1, OrAddr2) of true -> [Addr|Trees]; @@ -1064,8 +1505,8 @@ is_in_intersection(#'GeneralSubtree'{base = {x400Address, OrAddr1}} = Addr, [#'GeneralSubtree'{base = {x400Address, ""}} | Trees] end; -is_in_intersection(#'GeneralSubtree'{base = {Type, Name1}} = Name, - [#'GeneralSubtree'{base = {Type, Name2}} +is_in_intersection(#'GeneralSubtree'{base = {Type, Name1}} = Name, + [#'GeneralSubtree'{base = {Type, Name2}} | Trees]) -> case case_insensitive_match(Name1, Name2) of true -> @@ -1084,8 +1525,8 @@ type_subtree_names(Type, SubTrees) -> is_permitted_ip([], [], []) -> true; -is_permitted_ip([CandidatIp | CandidatIpRest], - [PermittedIp | PermittedIpRest], [Mask | MaskRest] ) -> +is_permitted_ip([CandidatIp | CandidatIpRest], + [PermittedIp | PermittedIpRest], [Mask | MaskRest] ) -> case mask_cmp(CandidatIp, PermittedIp, Mask) of true -> is_permitted_ip(CandidatIpRest, PermittedIpRest, MaskRest); @@ -1107,28 +1548,28 @@ is_valid_host_or_domain(Canditate, Permitted) -> [_, CanditateHost] -> case_insensitive_match(CanditateHost, Permitted) end. + is_valid_email_address(Canditate, [$.|Permitted], [_]) -> is_suffix(Permitted, Canditate); - is_valid_email_address(Canditate, PermittedHost, [_]) -> [_ , CanditateHost] = string:tokens(Canditate,"@"), case_insensitive_match(CanditateHost, PermittedHost); - is_valid_email_address(Canditate, Permitted, [_, _]) -> case_insensitive_match(Canditate, Permitted). is_suffix(Suffix, Str) -> lists:suffix(string:casefold(Suffix), string:casefold(Str)). + case_insensitive_match(Str1, Str2) -> string:equal(Str1, Str2, true). is_or_address(Address, Canditate) -> %% TODO: Is case_insensitive_match sufficient? %% study rfc2156 probably need more a complex check. - is_double_quoted(Address) andalso - is_double_quoted(Canditate) andalso + is_double_quoted(Address) andalso + is_double_quoted(Canditate) andalso case_insensitive_match(Address, Canditate). - + is_double_quoted(["\"" | Tail]) -> is_double_quote(lists:last(Tail)); is_double_quoted("%22" ++ Tail) -> @@ -1149,33 +1590,69 @@ is_double_quote("\"") -> is_double_quote(_) -> false. -add_policy_constraints(ExpPolicy, MapPolicy, - #path_validation_state{cert_num = CertNum, - explicit_policy = CurExpPolicy, - policy_mapping = CurMapPolicy} = - ValidationState) -> - - NewExpPolicy = policy_constraint(CurExpPolicy, ExpPolicy, CertNum), - NewMapPolicy = policy_constraint(CurMapPolicy, MapPolicy, CertNum), +%%==================================================================== +%% Signature handling +%%==================================================================== - ValidationState#path_validation_state{explicit_policy = NewExpPolicy, - policy_mapping = NewMapPolicy}. +extract_verify_data(OtpCert, DerCert) -> + Signature = OtpCert#'OTPCertificate'.signature, + SigAlg = OtpCert#'OTPCertificate'.signatureAlgorithm, + PlainText = encoded_tbs_cert(DerCert), + {DigestType,_,_} = x509_pkix_sign_types(SigAlg), + {DigestType, PlainText, Signature}. -policy_constraint(Current, asn1_NOVALUE, _) -> - Current; -policy_constraint(Current, New, CertNum) -> - erlang:min(Current, New + CertNum). +verify_signature(OtpCert, DerCert, Key, KeyParams) -> + {DigestType, PlainText, Signature} = extract_verify_data(OtpCert, DerCert), + case Key of + #'RSAPublicKey'{} -> + case KeyParams of + #'RSASSA-PSS-params'{} -> + public_key:verify(PlainText, DigestType, Signature, Key, + verify_options(KeyParams)); + 'NULL' -> + public_key:verify(PlainText, DigestType, Signature, Key) + end; + _ -> + public_key:verify(PlainText, DigestType, Signature, {Key, KeyParams}) + end. -process_policy_tree(_,_, ?NULL) -> - ?NULL; -process_policy_tree(_Id, _Qualifier, Tree) -> - %% TODO real imp. - Tree. +encoded_tbs_cert(Cert) -> + {ok, PKIXCert} = + 'OTP-PUB-KEY':decode_TBSCert_exclusive(Cert), + {'Certificate', + {'Certificate_tbsCertificate', EncodedTBSCert}, _, _} = PKIXCert, + EncodedTBSCert. -policy_indicator(_, true) -> - 0; -policy_indicator(N, false) -> - N + 1. +public_key_info(PublicKeyInfo, + #path_validation_state{working_public_key_algorithm = + WorkingAlgorithm, + working_public_key_parameters = + WorkingParams}) -> + PublicKey = PublicKeyInfo#'OTPSubjectPublicKeyInfo'.subjectPublicKey, + AlgInfo = PublicKeyInfo#'OTPSubjectPublicKeyInfo'.algorithm, + + PublicKeyParams = AlgInfo#'PublicKeyAlgorithm'.parameters, + Algorithm = AlgInfo#'PublicKeyAlgorithm'.algorithm, + + NewPublicKeyParams = + case PublicKeyParams of + {null, 'NULL'} when WorkingAlgorithm == Algorithm -> + WorkingParams; + asn1_NOVALUE when Algorithm == ?'id-Ed25519'; + Algorithm == ?'id-Ed448' -> + {namedCurve, Algorithm}; + {params, Params} -> + Params; + Params -> + Params + end, + {Algorithm, PublicKey, NewPublicKeyParams}. + + +extensions_list(asn1_NOVALUE) -> + []; +extensions_list(Extensions) -> + Extensions. is_fixed_dh_cert(PublicKeyInfo, Extensions) -> AlgInfo = PublicKeyInfo#'OTPSubjectPublicKeyInfo'.algorithm, @@ -1215,6 +1692,13 @@ missing_basic_constraints(OtpCert, SelfSigned, ValidationState, VerifyFun, UserS UserState} end. +is_valid_key_usage(KeyUse, Use) -> + lists:member(Use, KeyUse). + +%%==================================================================== +%% Generate test data +%%==================================================================== + gen_key(KeyGen) -> case is_key(KeyGen) of true -> @@ -1237,9 +1721,9 @@ is_key(_) -> cert_template() -> #'OTPTBSCertificate'{ - version = v3, + version = v3, serialNumber = erlang:unique_integer([positive, monotonic]), - issuerUniqueID = asn1_NOVALUE, + issuerUniqueID = asn1_NOVALUE, subjectUniqueID = asn1_NOVALUE }. @@ -1259,37 +1743,36 @@ subject(SubjectOpts) when is_list(SubjectOpts) -> end, {rdnSequence, [Encode(Opt) || Opt <- SubjectOpts]}. -subject_enc({name, Name}) -> +subject_enc({name, Name}) -> {?'id-at-commonName', {printableString, Name}}; -subject_enc({email, Email}) -> +subject_enc({email, Email}) -> {?'id-emailAddress', Email}; -subject_enc({city, City}) -> +subject_enc({city, City}) -> {?'id-at-localityName', {printableString, City}}; -subject_enc({org, Org}) -> +subject_enc({org, Org}) -> {?'id-at-organizationName', {printableString, Org}}; -subject_enc({org_unit, OrgUnit}) -> +subject_enc({org_unit, OrgUnit}) -> {?'id-at-organizationalUnitName', {printableString, OrgUnit}}; -subject_enc({country, Country}) -> +subject_enc({country, Country}) -> {?'id-at-countryName', Country}. validity(Opts) -> DefFrom0 = calendar:gregorian_days_to_date(calendar:date_to_gregorian_days(date())-1), DefTo0 = calendar:gregorian_days_to_date(calendar:date_to_gregorian_days(date())+7), {DefFrom, DefTo} = proplists:get_value(validity, Opts, {DefFrom0, DefTo0}), - + GenFormat = fun({Y,M,D}) -> lists:flatten( io_lib:format("~4..0w~2..0w~2..0w130000Z",[Y,M,D])) end, - + UTCFormat = fun({Y,M,D}) -> [_, _, Y3, Y4] = integer_to_list(Y), lists:flatten( io_lib:format("~s~2..0w~2..0w130000Z",[[Y3, Y4],M,D])) end, - #'Validity'{notBefore = validity_format(DefFrom, GenFormat, UTCFormat), notAfter = validity_format(DefTo, GenFormat, UTCFormat)}. @@ -1310,12 +1793,13 @@ sign_algorithm(#'RSAPrivateKey'{} = Key , Opts) -> end; sign_algorithm({#'RSAPrivateKey'{} = Key,#'RSASSA-PSS-params'{} = Params}, _Opts) -> rsa_sign_algo(Key, ?'id-RSASSA-PSS', Params); - + sign_algorithm(#'DSAPrivateKey'{p=P, q=Q, g=G}, _Opts) -> #'SignatureAlgorithm'{algorithm = ?'id-dsa-with-sha1', parameters = {params,#'Dss-Parms'{p=P, q=Q, g=G}}}; -sign_algorithm(#'ECPrivateKey'{parameters = {namedCurve, EDCurve}}, _Opts) when EDCurve == ?'id-Ed25519'; - EDCurve == ?'id-Ed448' -> +sign_algorithm(#'ECPrivateKey'{parameters = {namedCurve, EDCurve}}, _Opts) + when EDCurve == ?'id-Ed25519'; + EDCurve == ?'id-Ed448' -> #'SignatureAlgorithm'{algorithm = EDCurve, parameters = asn1_NOVALUE}; sign_algorithm(#'ECPrivateKey'{parameters = Parms}, Opts) -> @@ -1325,12 +1809,12 @@ sign_algorithm(#'ECPrivateKey'{parameters = Parms}, Opts) -> rsa_sign_algo(#'RSAPrivateKey'{}, ?'id-RSASSA-PSS' = Type, #'RSASSA-PSS-params'{} = Params) -> #'SignatureAlgorithm'{algorithm = Type, - parameters = Params}; + parameters = Params}; rsa_sign_algo(#'RSAPrivateKey'{}, Type, Parms) -> #'SignatureAlgorithm'{algorithm = Type, parameters = Parms}. -rsa_digest_oid(Oid) when is_tuple(Oid) -> +rsa_digest_oid(Oid) when is_tuple(Oid) -> Oid; rsa_digest_oid(sha1) -> ?'sha1WithRSAEncryption'; @@ -1345,7 +1829,7 @@ rsa_digest_oid(sha256) -> rsa_digest_oid(md5) -> ?'md5WithRSAEncryption'. -ecdsa_digest_oid(Oid) when is_tuple(Oid) -> +ecdsa_digest_oid(Oid) when is_tuple(Oid) -> Oid; ecdsa_digest_oid(sha1) -> ?'ecdsa-with-SHA1'; @@ -1366,23 +1850,23 @@ cert_chain(Role, Root, RootKey, Opts) -> cert_chain(Role, IssuerCert, IssuerKey, [PeerOpts], _, Acc) -> Key = gen_key(proplists:get_value(key, PeerOpts, default_key_gen())), - Cert = cert(Role, public_key:pkix_decode_cert(IssuerCert, otp), + Cert = cert(Role, public_key:pkix_decode_cert(IssuerCert, otp), IssuerKey, Key, "admin", " Peer cert", PeerOpts, peer), [{Cert, encode_key(Key)}, {IssuerCert, encode_key(IssuerKey)} | Acc]; cert_chain(Role, IssuerCert, IssuerKey, [CAOpts | Rest], N, Acc) -> Key = gen_key(proplists:get_value(key, CAOpts, default_key_gen())), - Cert = cert(Role, public_key:pkix_decode_cert(IssuerCert, otp), IssuerKey, Key, "webadmin", + Cert = cert(Role, public_key:pkix_decode_cert(IssuerCert, otp), IssuerKey, Key, "webadmin", " Intermediate CA " ++ integer_to_list(N), CAOpts, ca), cert_chain(Role, Cert, Key, Rest, N+1, [{IssuerCert, encode_key(IssuerKey)} | Acc]). -cert(Role, #'OTPCertificate'{tbsCertificate = #'OTPTBSCertificate'{subject = Issuer}}, +cert(Role, #'OTPCertificate'{tbsCertificate = #'OTPTBSCertificate'{subject = Issuer}}, PrivKey, Key, Contact, Name, Opts, Type) -> TBS = cert_template(), SignAlgoId = sign_algorithm(PrivKey, Opts), OTPTBS = TBS#'OTPTBSCertificate'{ signature = SignAlgoId, issuer = Issuer, - validity = validity(Opts), + validity = validity(Opts), subject = subject(Contact, atom_to_list(Role) ++ Name), subjectPublicKeyInfo = public_key(Key, SignAlgoId), extensions = extensions(Role, Type, Opts) @@ -1408,7 +1892,7 @@ public_key(#'RSAPrivateKey'{modulus=N, publicExponent=E}, Algo = #'PublicKeyAlgorithm'{algorithm= ?rsaEncryption, parameters = Params}, #'OTPSubjectPublicKeyInfo'{algorithm = Algo, subjectPublicKey = Public}; -public_key({#'RSAPrivateKey'{modulus=N, publicExponent=E}, #'RSASSA-PSS-params'{} = Params}, +public_key({#'RSAPrivateKey'{modulus=N, publicExponent=E}, #'RSASSA-PSS-params'{} = Params}, #'SignatureAlgorithm'{algorithm = ?'id-RSASSA-PSS', parameters = #'RSASSA-PSS-params'{} = Params}) -> Public = #'RSAPublicKey'{modulus=N, publicExponent=E}, @@ -1421,7 +1905,7 @@ public_key(#'RSAPrivateKey'{modulus=N, publicExponent=E}, _) -> #'OTPSubjectPublicKeyInfo'{algorithm = Algo, subjectPublicKey = Public}; public_key(#'DSAPrivateKey'{p=P, q=Q, g=G, y=Y}, _) -> - Algo = #'PublicKeyAlgorithm'{algorithm= ?'id-dsa', + Algo = #'PublicKeyAlgorithm'{algorithm= ?'id-dsa', parameters={params, #'Dss-Parms'{p=P, q=Q, g=G}}}, #'OTPSubjectPublicKeyInfo'{algorithm = Algo, subjectPublicKey = Y}; public_key(#'ECPrivateKey'{version = _Version, @@ -1469,18 +1953,18 @@ add_default_extensions(server, peer, Exts) -> critical = false} ], add_default_extensions(Default, Exts); - + add_default_extensions(client, peer, Exts) -> Exts. add_default_extensions(Defaults0, Exts) -> Defaults = lists:filtermap(fun(#'Extension'{extnID = ID} = Ext) -> - case lists:keymember(ID, 2, Exts) of - true -> - false; - false -> - {true, Ext} - end + case lists:keymember(ID, 2, Exts) of + true -> + false; + false -> + {true, Ext} + end end, Defaults0), Exts ++ Defaults. @@ -1494,11 +1978,14 @@ encode_key(#'ECPrivateKey'{} = Key) -> encode_key(#'DSAPrivateKey'{} = Key) -> {'DSAPrivateKey', public_key:der_encode('DSAPrivateKey', Key)}. -verify_options(#'RSASSA-PSS-params'{saltLength = SaltLen, - maskGenAlgorithm = - #'MaskGenAlgorithm'{algorithm = ?'id-mgf1', - parameters = #'HashAlgorithm'{algorithm = HashOid}}}) -> +verify_options( + #'RSASSA-PSS-params'{saltLength = SaltLen, + maskGenAlgorithm = + #'MaskGenAlgorithm'{algorithm = ?'id-mgf1', + parameters = + #'HashAlgorithm'{algorithm = HashOid}}}) -> HashAlgo = public_key:pkix_hash_type(HashOid), [{rsa_padding, rsa_pkcs1_pss_padding}, {rsa_pss_saltlen, SaltLen}, {rsa_mgf1_md, HashAlgo}]. + diff --git a/lib/public_key/src/pubkey_policy_tree.erl b/lib/public_key/src/pubkey_policy_tree.erl new file mode 100644 index 000000000000..dcdd40c8d9e1 --- /dev/null +++ b/lib/public_key/src/pubkey_policy_tree.erl @@ -0,0 +1,416 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 2023-2023. 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. +%% +%% %CopyrightEnd% +%% +-module(pubkey_policy_tree). + +-include("../include/public_key.hrl"). + +%% API +-export([add_leaves/2, + add_siblings/2, + any_leaves/2, + collect_qualifiers/2, + constrained_policy_node_set/1, + empty/0, + in_set/2, + is_empty/1, + map_leaves/2, + policy_node/3, + prune_leaves/2, + prune_tree/1, + prune_invalid_nodes/2, + root/0, + valid_policy_node_set/1 + ]). + +-export_type([policy_tree/0]). + +-type policy_node() :: + #{valid_policy := public_key:oid(), + qualifier_set := [#'PolicyInformation'{}], + expected_policy_set := [public_key:oid()]}. + +-type policy_tree_node() :: {policy_node(), [policy_tree_node()] | + [policy_node()]}. + +-opaque policy_tree() :: {} | policy_tree_node(). + +%%%=================================================================== +%%% Internal API +%%%=================================================================== + +%%-------------------------------------------------------------------- +-spec add_leaves(policy_tree(), LeafFun) -> policy_tree() when + LeafFun :: fun((policy_tree_node()) -> [policy_node()]). + +%% +%% Add leaves specified by calling LeafFun with the current leaves +%% as input +%%-------------------------------------------------------------------- +add_leaves({Parent, []}, LeafFun) -> + {Parent, LeafFun(Parent)}; +add_leaves(Tree, LeafFun0) -> + LeafFun = fun(Leaf) -> + NewLeaves = LeafFun0(Leaf), + {Leaf, NewLeaves} + end, + map_leaves(Tree, LeafFun). + +%%-------------------------------------------------------------------- +-spec add_siblings(policy_tree(), SiblingFun) -> policy_tree() when + SiblingFun ::fun((policy_tree_node()) -> no_sibling | [policy_node()]). + +%% +%% Add sibling leaves if SiblingFun returns a list of policy nodes +%% for the leaf parent. +%%-------------------------------------------------------------------- +add_siblings({Parent,[{_, _}|_] = ChildNodes}, SiblingFun) -> + {Parent, lists:map(fun(ChildNode)-> + add_siblings(ChildNode, SiblingFun) + end, ChildNodes)}; +add_siblings({Parent, Leaves} = Node, SiblingFun) -> + case SiblingFun(Parent) of + no_sibling -> + Node; + Siblings -> + {Parent, Leaves ++ Siblings} + end. + +%%-------------------------------------------------------------------- +-spec any_leaves(policy_tree(), Level::integer()) -> no_node | [policy_node()]. +%% +%% Find leaf policy nodes at tree with valid_policy = ?anyPolicy if they exists +%%-------------------------------------------------------------------- +any_leaves({}, _) -> + no_node; +any_leaves({_,[{_, _}|_] = ChildNodes}, Level) -> + lists:flatmap(fun(ChildNode)-> + any_leaves(ChildNode, Level-1) + end, ChildNodes); +any_leaves({_, Leaves}, 0) -> + AnyLeaf = fun(#{valid_policy := ?anyPolicy} = Node) -> + {true, Node}; + (_) -> + false + end, + lists:filtermap(AnyLeaf, Leaves); +any_leaves(_,_) -> + no_node. + +%%-------------------------------------------------------------------- +-spec collect_qualifiers(policy_tree(), Policy::public_key:oid()) -> [{uri, string()} | #'UserNotice'{}]. +%% +%% Collect qualifiers from tree branch asserting Policy +%%-------------------------------------------------------------------- +collect_qualifiers({_, ChildNodes}, Policy) -> + FormatQualifier = + fun(#'PolicyQualifierInfo'{policyQualifierId = ?'id-qt-unotice', + qualifier = Qualifier}) -> + try public_key:der_decode('UserNotice', Qualifier) of + Notice -> + Notice + catch error:_ -> + handle_too_long_notice(Qualifier) + end; + (#'PolicyQualifierInfo'{policyQualifierId = ?'id-qt-cps', + qualifier = Qualifier}) -> + {uri, public_key:der_decode('CPSuri', Qualifier)} + end, + Collect = fun(#{qualifier_set := QSet}) -> + lists:map(FormatQualifier, QSet) + end, + case collect_children_qualifiers(Collect, ChildNodes, Policy) of + [] -> + collect_children_qualifiers(Collect, ChildNodes, ?anyPolicy); + QSet -> + QSet + end. + +%% -------------------------------------------------------------------- +-spec constrained_policy_node_set(policy_tree()) -> [policy_node()]. + +%% +%% From: PKITS.pdf: +%% If the valid_policy_tree includes a leaf node with a valid_policy +%% of anyPolicy, then the user-constrained-policy-set is +%% any-policy. Otherwise, the user-constrained-policy-set consists of +%% the set containing the valid_policy from each node in the +%% valid_policy_tree in which the valid_policy is not anyPolicy and +%% the valid_policy of that node's parent is anyPolicy. The +%% authorities-constrained-policy-set may be computed using the same +%% procedure on the valid_policy_tree before its intersection with the +%% user-initial-policy-set has been computed (in step g of section 6.1.5). +%% +%% That is this function calculates the valid policy node +%% set after being constrained either by the user or only by the +%% authorities (certificate extensions). +%% -------------------------------------------------------------------- +constrained_policy_node_set({}) -> + []; +constrained_policy_node_set(Tree) -> + case any_leaves(Tree) of + [] -> + constrain(Tree); + AnyLeaves -> + AnyLeaves + end. + +%%-------------------------------------------------------------------- +-spec empty() -> policy_tree(). +%%-------------------------------------------------------------------- +empty() -> + %% The empty tree is refered to as NULL in RFC 5280 + {}. + +%%-------------------------------------------------------------------- +-spec in_set(Policy::public_key:oid(), Set::[policy_node()]) -> boolean(). +%% +%% Is there a node with in +%%-------------------------------------------------------------------- +in_set(_, []) -> + false; +in_set(Policy, [#{valid_policy := Policy} |_]) -> + true; +in_set(Policy, [_ | Rest]) -> + in_set(Policy, Rest). + +%%-------------------------------------------------------------------- +-spec is_empty(policy_tree()) -> boolean(). +%%-------------------------------------------------------------------- +is_empty({}) -> + true; +is_empty(_) -> + false. + +%%-------------------------------------------------------------------- +-spec map_leaves(policy_tree(), LeafFun::function()) -> policy_tree(). +%% +%% Update all leaves as determined by +%%-------------------------------------------------------------------- +map_leaves({Parent, [{_, _}|_] = ChildNodes}, LeafFun) -> + {Parent, lists:map(fun(ChildNode)-> + map_leaves(ChildNode, LeafFun) + end, ChildNodes)}; +map_leaves({Parent, Leaves}, LeafFun) -> + {Parent, lists:map(LeafFun, Leaves)}. + +%%-------------------------------------------------------------------- +-spec prune_leaves(policy_tree(), Policy::public_key:oid()) -> policy_tree(). +%% +%% Delete all leaves with the valid_policy in a pruned policy tree +%%-------------------------------------------------------------------- +prune_leaves({} = Empty, _) -> + Empty; +prune_leaves({_, _} = Tree, Policy) -> + LeafFun = fun(#{valid_policy := ValidPolicy} = Node) -> + case ValidPolicy of + Policy -> + false; + _ -> + {true, Node} + end + end, + filter_leaves(Tree, LeafFun). + +%%-------------------------------------------------------------------- +-spec prune_tree(policy_tree()) -> policy_tree(). +%% +%% Delete branches that are shorher than the total depth of the tree. +%%-------------------------------------------------------------------- +prune_tree({} = Empty) -> + Empty; +prune_tree({_, []}) -> + empty(); +prune_tree({Root, ChildNodes}) -> + case prune_children(ChildNodes) of + [] -> + empty(); + NewChildNodes -> + {Root, NewChildNodes} + end. + +%%-------------------------------------------------------------------- +-spec prune_invalid_nodes(policy_tree(), [policy_node()]) -> policy_tree(). +%% +%% Delete all invalid policy nodes and their children. +%%-------------------------------------------------------------------- +prune_invalid_nodes(Tree, []) -> + Tree; +prune_invalid_nodes({Root, ChildNodes}, InvalidNodes) -> + case prune_invalid_nodes_children(ChildNodes, InvalidNodes) of + [] -> %% No leaves left the tree becomes empty + empty(); + NewChildNodes -> %% Keep root that is always ?anyPolicy + {Root, NewChildNodes} + end. +%%-------------------------------------------------------------------- +-spec policy_node(public_key:oid(), term(), [public_key:oid()]) -> policy_node(). +%% +%% Creates a policy node +%%-------------------------------------------------------------------- +policy_node(ValidPolicy, Qualifiers, ExpPolicySet) -> + QualifierSet = + case Qualifiers of + asn1_NOVALUE -> + []; + _ -> + Qualifiers + end, + #{valid_policy => ValidPolicy, + qualifier_set => QualifierSet, + expected_policy_set => ExpPolicySet}. + +%%-------------------------------------------------------------------- +-spec root() -> policy_tree(). +%% +%% Create initial root node used as start value when building the policy tree. +%%-------------------------------------------------------------------- +root() -> + {any_policy_node(), []}. + +%%-------------------------------------------------------------------- +-spec valid_policy_node_set(policy_tree()) -> [policy_node()]. +%% +%% Determine the set of policy nodes whose parent nodes have a +%% valid_policy of anyPolicy. This is the valid_policy_node_set. +%%-------------------------------------------------------------------- +valid_policy_node_set({#{valid_policy := ?anyPolicy}, [{_, _}| _] = ChildNodes}) -> + Parents = [Parent || {Parent, _} <- ChildNodes], + Parents ++ lists:foldl(fun(ChildNode, Acc) -> + valid_policy_node_set(ChildNode) ++ Acc + end, [], ChildNodes); +valid_policy_node_set({#{valid_policy := ?anyPolicy}, Leaves}) when is_list(Leaves) -> + Leaves; +valid_policy_node_set(_) -> + []. + +%%%=================================================================== +%%% Internal functions +%%%=================================================================== +any_policy_node() -> + policy_node(?anyPolicy, [], [?anyPolicy]). + +any_leaves({_,[{_, _}|_] = ChildNodes}) -> + lists:flatmap(fun(ChildNode)-> + any_leaves(ChildNode) + end, ChildNodes); +any_leaves({_, Leaves}) -> + AnyLeaf = fun(#{valid_policy := ?anyPolicy} = Node) -> + {true, Node}; + (_) -> + false + end, + lists:filtermap(AnyLeaf, Leaves). + +collect_children_qualifiers(_, [], _) -> + []; +collect_children_qualifiers(Collect, [{#{expected_policy_set := Set}, _} = ChildNode | ChildNodes], Policy) -> + case lists:member(Policy, Set) of + true -> + lists:flatten(children_collect(Collect, ChildNode)); + false -> + collect_children_qualifiers(Collect, ChildNodes, Policy) + end; +collect_children_qualifiers(Collect, ChildNodes, _) -> + lists:flatten(children_collect(Collect, ChildNodes)). + +children_collect(Collect, {Parent, ChildNodes}) -> + Collect(Parent) ++ children_collect(Collect, ChildNodes); +children_collect(Collect, [ {_,_} = ChildNode | ChildNodes]) -> + children_collect(Collect, ChildNode) ++ children_collect(Collect, ChildNodes); +children_collect(Collect, Leaves) -> + lists:map(Collect, Leaves). + +constrain({#{valid_policy := ?anyPolicy}, [{_, _}| _] = ChildNodes}) -> + Parents = [Parent || {Parent, _} <- ChildNodes], + lists:filtermap(fun(#{valid_policy := ?anyPolicy}) -> + false; + (Node) -> + {true, Node} + end, Parents) ++ + lists:foldl(fun(Child, Acc) -> + constrain(Child) ++ Acc + end, [], ChildNodes); +constrain({#{valid_policy := ?anyPolicy}, Leaves}) when is_list(Leaves) -> + lists:filtermap(fun(#{valid_policy := ?anyPolicy}) -> + false; + (Node) -> + {true, Node} + end, Leaves); +constrain(_) -> + []. + +filter_leaves({Parent,[{_, _}|_] = ChildNodes}, LeafFun) -> + {Parent, lists:map(fun(ChildNode)-> + filter_leaves(ChildNode, LeafFun) + end, ChildNodes)}; +filter_leaves({Parent, Leaves}, LeafFun) -> + {Parent, lists:filtermap(LeafFun, Leaves)}. + +keep_policy_node(#{valid_policy := ?anyPolicy} = Node, _) -> + {true, Node}; +keep_policy_node(Node, InvalidNodes) -> + case lists:member(Node, InvalidNodes) of + true -> + false; + false -> + {true, Node} + end. + +prune_children(ChildNodes) when is_list(ChildNodes) -> + lists:filtermap(fun({Parent, ChildNode}) -> + case prune_nodes(Parent, ChildNode) of + {Parent, []} -> + false; + {Parent, NewChildNode} -> + {true, {Parent, NewChildNode}} + end; + (Leaves) -> + {true, Leaves} + end, ChildNodes). + +prune_nodes(Parent, ChildNodes) -> + {Parent, prune_children(ChildNodes)}. + +prune_invalid_nodes_children(ChildNodes, InvalidNodes) when is_list(ChildNodes)-> + lists:filtermap(fun({Parent, Children}) -> + case keep_policy_node(Parent, InvalidNodes) of + false -> %% Prune subtree + false; + {true, #{valid_policy := ?anyPolicy} = Parent} -> %% Keep Parent + {true, {Parent, prune_invalid_nodes_children(Children, InvalidNodes)}}; + {true, Parent} -> + {true, {Parent, Children}} %% Keep subtree + end; + (#{} = Child) -> % Possibly prune leaf + keep_policy_node(Child, InvalidNodes) + end, ChildNodes). + +handle_too_long_notice(Qualifier) -> + %% RFC 3280 states that certificate users SHOULD gracefully handle + %% explicitText with more than 200 characters. + try public_key:der_decode('OTPUserNotice', Qualifier) of % Allow real value up to 350 + #'OTPUserNotice'{noticeRef = Ref, + explicitText = DispText} -> + #'UserNotice'{noticeRef = Ref, + explicitText = DispText} + catch error:_ -> %% Otherwhise return gracefully default + #'UserNotice'{noticeRef = asn1_NOVALUE, + explicitText = "User Notice much too long, so value is ignored"} + end. diff --git a/lib/public_key/src/public_key.app.src b/lib/public_key/src/public_key.app.src index 5d8f936e33bc..345b7554c2b1 100644 --- a/lib/public_key/src/public_key.app.src +++ b/lib/public_key/src/public_key.app.src @@ -1,23 +1,24 @@ {application, public_key, [{description, "Public key infrastructure"}, {vsn, "%VSN%"}, - {modules, [ public_key, - pubkey_pem, - pubkey_pbe, - pubkey_ssh, - pubkey_cert, - pubkey_cert_records, - pubkey_crl, - pubkey_ocsp, - pubkey_os_cacerts, - 'OTP-PUB-KEY', - 'PKCS-FRAME' - ]}, + {modules, [public_key, + pubkey_pem, + pubkey_pbe, + pubkey_ssh, + pubkey_cert, + pubkey_policy_tree, + pubkey_cert_records, + pubkey_crl, + pubkey_ocsp, + pubkey_os_cacerts, + 'OTP-PUB-KEY', + 'PKCS-FRAME' + ]}, {applications, [asn1, crypto, kernel, stdlib]}, {registered, []}, {env, []}, {runtime_dependencies, ["stdlib-3.5","kernel-3.0","erts-6.0","crypto-4.6", "asn1-3.0"]} - ] + ] }. diff --git a/lib/public_key/src/public_key.erl b/lib/public_key/src/public_key.erl index 33b404089a0f..35ef83f58a33 100644 --- a/lib/public_key/src/public_key.erl +++ b/lib/public_key/src/public_key.erl @@ -90,25 +90,27 @@ %%---------------------------------------------------------------- %% Types --export_type([public_key/0, - private_key/0, - pem_entry/0, - pki_asn1_type/0, - asn1_type/0, - der_encoded/0, - key_params/0, - digest_type/0, - issuer_name/0, +-export_type([asn1_type/0, + bad_cert_reason/0, cert/0, - combined_cert/0, cert_id/0, - oid/0, cert_opt/0, chain_opts/0, + combined_cert/0, conf_opt/0, + der_encoded/0, + digest_type/0, + issuer_name/0, + key_params/0, + oid/0, + pem_entry/0, + pki_asn1_type/0, + policy_node/0, + private_key/0, + public_key/0, test_config/0, - test_root_cert/0]). - + test_root_cert/0 + ]). -type public_key() :: rsa_public_key() | rsa_pss_public_key() | dsa_public_key() | ec_public_key() | ed_public_key() . -type private_key() :: rsa_private_key() | rsa_pss_private_key() | dsa_private_key() | ec_private_key() | ed_private_key() . @@ -160,11 +162,16 @@ -type oid() :: tuple(). -type cert_id() :: {SerialNr::integer(), issuer_name()} . -type issuer_name() :: {rdnSequence,[[#'AttributeTypeAndValue'{}]]} . --type bad_cert_reason() :: cert_expired | invalid_issuer | invalid_signature | name_not_permitted | missing_basic_constraint | invalid_key_usage | duplicate_cert_in_path | {revoked, crl_reason()} | atom(). +-type bad_cert_reason() :: cert_expired | invalid_issuer | invalid_signature | name_not_permitted | missing_basic_constraint | invalid_key_usage | duplicate_cert_in_path | + {'policy_requirement_not_met', term()} | {'invalid_policy_mapping', term()} | {revoked, crl_reason()} | atom(). -type combined_cert() :: #cert{}. -type cert() :: der_cert() | otp_cert(). -type der_cert() :: der_encoded(). +-type policy_node() :: + #{valid_policy := public_key:oid(), + qualifier_set := [#'UserNotice'{}| {uri, string()}], + expected_policy_set := [public_key:oid()]}. -type otp_cert() :: #'OTPCertificate'{}. -type public_key_info() :: {key_oid_name(), rsa_public_key() | #'ECPoint'{} | dss_public_key(), public_key_params()}. -type key_oid_name() :: 'rsaEncryption' | 'id-RSASSA-PSS' | 'id-ecPublicKey' | 'id-Ed25519' | 'id-Ed448' | 'id-dsa'. @@ -1134,14 +1141,14 @@ pkix_normalize_name(Issuer) -> %%-------------------------------------------------------------------- -spec pkix_path_validation(Cert, CertChain, Options) -> - {ok, {PublicKeyInfo, PolicyTree}} | + {ok, {PublicKeyInfo, ConstrainedPolicyNodes}} | {error, {bad_cert, Reason :: bad_cert_reason()}} when Cert :: cert() | atom(), CertChain :: [cert() | combined_cert()], Options :: [{max_path_length, integer()} | {verify_fun, {fun(), term()}}], PublicKeyInfo :: public_key_info(), - PolicyTree :: list(). + ConstrainedPolicyNodes :: [policy_node()]. %% Description: Performs a basic path validation according to RFC 5280. %%-------------------------------------------------------------------- @@ -1580,7 +1587,16 @@ path_validation([], #path_validation_state{working_public_key_algorithm = PublicKeyParams, valid_policy_tree = Tree }) -> - {ok, {{Algorithm, PublicKey, PublicKeyParams}, Tree}}; + ValidPolicyNodeSet0 = pubkey_policy_tree:constrained_policy_node_set(Tree), + CollectQualifiers = fun(#{expected_policy_set := PolicySet} = Node) -> + QF = fun(Policy) -> + pubkey_policy_tree:collect_qualifiers(Tree, Policy) + end, + Qualifiers = lists:flatmap(QF, PolicySet), + Node#{qualifier_set => Qualifiers} + end, + ValidPolicyNodeSet = lists:map(CollectQualifiers, ValidPolicyNodeSet0), + {ok, {{Algorithm, PublicKey, PublicKeyParams}, ValidPolicyNodeSet}}; path_validation([DerCert | Rest], ValidationState = #path_validation_state{ max_path_length = Len}) when Len >= 0 -> diff --git a/lib/public_key/test/pkits_SUITE.erl b/lib/public_key/test/pkits_SUITE.erl index baa212ff65af..a3633ee6fa3b 100644 --- a/lib/public_key/test/pkits_SUITE.erl +++ b/lib/public_key/test/pkits_SUITE.erl @@ -14,7 +14,7 @@ %% 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. -%% +%% %% %CopyrightEnd% %% @@ -167,18 +167,102 @@ valid_uri_name_constraints/0, whitespace_name_chain/1, whitespace_name_chain/0, - - %% Marked as "Not supported yet": - certificate_policies/0, - certificate_policies/1, - require_explicit_policy/0, - require_explicit_policy/1, - policy_mappings/0, - policy_mappings/1, - inhibit_policy_mapping/0, - inhibit_policy_mapping/1, - inhibit_any_policy/0, - inhibit_any_policy/1 + certificate_all_same_policy/0, + certificate_all_same_policy/1, + certificate_no_policies/0, + certificate_no_policies/1, + certificate_different_policies_first_ca/0, + certificate_different_policies_first_ca/1, + certificate_different_policies_end_entity/0, + certificate_different_policies_end_entity/1, + certificate_different_policies_second_ca/0, + certificate_different_policies_second_ca/1, + certificate_overlapping_policies/0, + certificate_overlapping_policies/1, + certificate_different_policies_no_overlapp_7/0, + certificate_different_policies_no_overlapp_7/1, + certificate_different_policies_no_overlapp_8/0, + certificate_different_policies_no_overlapp_8/1, + certificate_different_policies_no_overlapp_9/0, + certificate_different_policies_no_overlapp_9/1, + certificate_all_same_policies/0, + certificate_all_same_policies/1, + certificate_all_any_policy/0, + certificate_all_any_policy/1, + certificate_different_policies/0, + certificate_different_policies/1, + certificate_all_same_policies_13/0, + certificate_all_same_policies_13/1, + certificate_any_policy/0, + certificate_any_policy/1, + certificate_user_notice_qualifier_15/0, + certificate_user_notice_qualifier_15/1, + certificate_user_notice_qualifier_16/0, + certificate_user_notice_qualifier_16/1, + certificate_user_notice_qualifier_17/0, + certificate_user_notice_qualifier_17/1, + certificate_user_notice_qualifier_18/0, + certificate_user_notice_qualifier_18/1, + certificate_user_notice_qualifier_19/0, + certificate_user_notice_qualifier_19/1, + certificate_cps_pointer_qualifier/0, + certificate_cps_pointer_qualifier/1, + require_explicit_valid_empty/0, + require_explicit_valid_empty/1, + require_explicit_valid/0, + require_explicit_valid/1, + require_explicit_invalid/0, + require_explicit_invalid/1, + require_explicit_valid_selfissued/0, + require_explicit_valid_selfissued/1, + require_explicit_invalid_selfissued/0, + require_explicit_invalid_selfissued/1, + valid_policy_mapping/0, + valid_policy_mapping/1, + invalid_policy_mapping_2/0, + invalid_policy_mapping_2/1, + valid_policy_mapping_3/0, + valid_policy_mapping_3/1, + invalid_policy_mapping_4/0, + invalid_policy_mapping_4/1, + valid_policy_mapping_5/0, + valid_policy_mapping_5/1, + valid_policy_mapping_6/0, + valid_policy_mapping_6/1, + invalid_policy_mapping_7/0, + invalid_policy_mapping_7/1, + invalid_policy_mapping_8/0, + invalid_policy_mapping_8/1, + valid_policy_mapping_9/0, + valid_policy_mapping_9/1, + invalid_policy_mapping_10/0, + invalid_policy_mapping_10/1, + valid_policy_mapping_11/0, + valid_policy_mapping_11/1, + valid_policy_mapping_12/0, + valid_policy_mapping_12/1, + valid_policy_mapping_13/0, + valid_policy_mapping_13/1, + valid_policy_mapping_14/0, + valid_policy_mapping_14/1, + inhibit_mapping_invalid/0, + inhibit_mapping_invalid/1, + inhibit_mapping_valid/0, + inhibit_mapping_valid/1, + inhibit_mapping_valid_selfissued/0, + inhibit_mapping_valid_selfissued/1, + inhibit_mapping_invalid_selfissued/0, + inhibit_mapping_invalid_selfissued/1, + inhibit_any_invalid_empty/0, + inhibit_any_invalid_empty/1, + inhibit_any_valid/0, + inhibit_any_valid/1, + inhibit_any_invalid/0, + inhibit_any_invalid/1, + inhibit_any_valid_selfissued/0, + inhibit_any_valid_selfissued/1, + inhibit_any_invalid_selfissued/0, + inhibit_any_invalid_selfissued/1 ]). -define(error(Format,Args), error(Format,Args,?FILE,?LINE)). @@ -198,10 +282,23 @@ -define(NIST5, "2.16.840.1.101.3.2.1.48.5"). -define(NIST6, "2.16.840.1.101.3.2.1.48.6"). +-define(NIST1_OID, {2,16,840,1,101,3,2,1,48,1}). +-define(NIST2_OID, {2,16,840,1,101,3,2,1,48,2}). +-define(NIST3_OID, {2,16,840,1,101,3,2,1,48,3}). +-define(NIST4_OID, {2,16,840,1,101,3,2,1,48,4}). +-define(NIST5_OID, {2,16,840,1,101,3,2,1,48,5}). +-define(NIST6_OID, {2,16,840,1,101,3,2,1,48,6}). +-define(NIST7_OID, {2,16,840,1,101,3,2,1,48,7}). +-define(NIST8_OID, {2,16,840,1,101,3,2,1,48,8}). + +-define(POLICY_ROOT, [[{expected_policy_set,[?anyPolicy]}, + {valid_policy, ?anyPolicy} + ]]). + -record(verify_state, { - crls, - crl_paths, - revoke_state}). + crls, + crl_paths, + revoke_state}). %%-------------------------------------------------------------------- %% Common Test interface functions ----------------------------------- %%-------------------------------------------------------------------- @@ -209,7 +306,7 @@ suite() -> []. -all() -> +all() -> [{group, signature_verification}, {group, validity_periods}, {group, verifying_name_chaining}, @@ -220,9 +317,15 @@ all() -> {group, verifying_basic_constraints}, {group, key_usage}, {group, name_constraints}, - {group, private_certificate_extensions}]. + {group, private_certificate_extensions}, + {group, policies}, + {group, require_explicit_policy}, + {group, policy_mappings}, + {group, inhibit_policy_mapping}, + {group, inhibit_any_policy} + ]. -groups() -> +groups() -> [{signature_verification, [], [valid_rsa_signature, invalid_rsa_signature, valid_dsa_signature, invalid_dsa_signature]}, @@ -261,7 +364,68 @@ groups() -> invalid_dns_name_constraints, valid_uri_name_constraints, invalid_uri_name_constraints]}, {private_certificate_extensions, [], - [unknown_critical_extension, unknown_not_critical_extension]} + [unknown_critical_extension, unknown_not_critical_extension]}, + {policies, [], [certificate_all_same_policy, + certificate_no_policies, + certificate_different_policies_first_ca, + certificate_different_policies_end_entity, + certificate_different_policies_second_ca, + certificate_overlapping_policies, + certificate_different_policies_no_overlapp_7, + certificate_different_policies_no_overlapp_8, + certificate_different_policies_no_overlapp_9, + certificate_all_same_policies, + certificate_all_any_policy, + certificate_different_policies, + certificate_all_same_policies_13, + certificate_any_policy, + certificate_user_notice_qualifier_15, + certificate_user_notice_qualifier_16, + certificate_user_notice_qualifier_17, + certificate_user_notice_qualifier_18, + certificate_user_notice_qualifier_19, + certificate_cps_pointer_qualifier + ]}, + {require_explicit_policy, [], + [ + require_explicit_valid_empty, + require_explicit_valid, + require_explicit_invalid, + require_explicit_valid_selfissued, + require_explicit_invalid_selfissued + ]}, + {policy_mappings, [], + [ + valid_policy_mapping, + invalid_policy_mapping_2, + valid_policy_mapping_3, + invalid_policy_mapping_4, + valid_policy_mapping_5, + valid_policy_mapping_6, + invalid_policy_mapping_7, + invalid_policy_mapping_8, + valid_policy_mapping_9, + invalid_policy_mapping_10, + valid_policy_mapping_11, + valid_policy_mapping_12, + valid_policy_mapping_13, + valid_policy_mapping_14 + ]}, + {inhibit_policy_mapping, [], + [ + inhibit_mapping_invalid, + inhibit_mapping_valid, + inhibit_mapping_valid_selfissued, + inhibit_mapping_invalid_selfissued + ]}, + {inhibit_any_policy, [], + [ + inhibit_any_invalid_empty, + inhibit_any_valid, + inhibit_any_invalid, + inhibit_any_valid_selfissued, + inhibit_any_invalid_selfissued + ]} ]. %%-------------------------------------------------------------------- @@ -419,13 +583,13 @@ missing_CRL() -> [{doc,"Test basic CRL handling"}]. missing_CRL(Config) when is_list(Config) -> run([{ "4.4.1", "Invalid Missing CRL Test1 EE",{bad_cert, - revocation_status_undetermined}}]). + revocation_status_undetermined}}]). revoked_CA() -> [{doc,"Test basic CRL handling"}]. revoked_CA(Config) when is_list(Config) -> run([{ "4.4.2", "Invalid Revoked CA Test2 EE", {bad_cert, - {revoked, keyCompromise}}}]). + {revoked, keyCompromise}}}]). revoked_peer() -> [{doc,"Test basic CRL handling"}]. @@ -437,7 +601,7 @@ invalid_CRL_signature() -> [{doc,"Test basic CRL handling"}]. invalid_CRL_signature(Config) when is_list(Config) -> run([{ "4.4.4", "Invalid Bad CRL Signature Test4 EE", - {bad_cert, revocation_status_undetermined}}]). + {bad_cert, revocation_status_undetermined}}]). invalid_CRL_issuer() -> [{doc,"Test basic CRL handling"}]. invalid_CRL_issuer(Config) when is_list(Config) -> @@ -565,31 +729,510 @@ valid_key_usage() -> valid_key_usage(Config) when is_list(Config) -> run([{ "4.7.3", "Valid keyUsage Not Critical Test3 EE", ok}]). +%%-----------------------------Certificate Policies------------------------------------- +certificate_all_same_policy() -> + [{doc,"Certificate all same policy tests"}]. +certificate_all_same_policy(Config) when is_list(Config) -> + run([{"4.8.1.1", "Valid Certificate Path Test1 EE", ok}, + {"4.8.1.2", "Valid Certificate Path Test1 EE", ok}, + {"4.8.1.3", "Valid Certificate Path Test1 EE", + {bad_cert, + {policy_requirement_not_met, + {{explicit_policy, 0}, + {policy_set, []}}}}}, + {"4.8.1.4", "Valid Certificate Path Test1 EE", ok}]). + +certificate_no_policies() -> + [{doc,"In this test, the certificatePolicies extension is omitted from " + "every certificate in the path."}]. +certificate_no_policies(Config) when is_list(Config) -> + run([{"4.8.2.1", "All Certificates No Policies Test2 EE ", ok}, + {"4.8.2.2", "All Certificates No Policies Test2 EE ", + {bad_cert, + {policy_requirement_not_met, + {{explicit_policy, 0}, + {policy_set, []}}}}}]). + +certificate_different_policies_first_ca() -> + [{doc,"In this test, every certificate in the path asserts the same certificate " + "policy except the first certificate in the path."}]. +certificate_different_policies_first_ca(Config) when is_list(Config) -> + run([{"4.8.3.1", "Different Policies Test3 EE", ok}, + {"4.8.3.2", "Different Policies Test3 EE ", {bad_cert, + {policy_requirement_not_met, + {{explicit_policy, 0}, + {policy_set, []}}}}}, + {"4.8.3.3", "Different Policies Test3 EE", {bad_cert, + {policy_requirement_not_met, + {{explicit_policy, 0}, + {policy_set, []}}}}} + ]). + +certificate_different_policies_end_entity() -> + [{doc,"In this test, every certificate in the path asserts the same certificate policy " + "except the end entity certificate"}]. +certificate_different_policies_end_entity(Config) when is_list(Config) -> + run([{"4.8.4", "Different Policies Test4 EE", + {bad_cert, + {policy_requirement_not_met, + {{explicit_policy, 0}, + {policy_set, []}}}}} + ]). + +certificate_different_policies_second_ca() -> + [{doc,"In this test, every certificate in the path except the second certificate asserts the same policy."}]. +certificate_different_policies_second_ca(Config) when is_list(Config) -> + run([{"4.8.5", "Different Policies Test5 EE", + {bad_cert, + {policy_requirement_not_met, + {{explicit_policy, 0}, + {policy_set, []}}}}} + ]). + +certificate_overlapping_policies() -> + [{doc,"The following path is such that the intersection of certificate policies among " + "all the certificates has exactly one policy, NIST-test-policy-1"}]. +certificate_overlapping_policies(Config) when is_list(Config) -> + run([{"4.8.6.1", "Overlapping Policies Test6 EE", ok}, + {"4.8.6.2", "Overlapping Policies Test6 EE", ok}, + {"4.8.6.3", "Overlapping Policies Test6 EE", + {bad_cert, + {policy_requirement_not_met, + {{explicit_policy, 0}, + {policy_set, []}}}}} + ]). + + +certificate_different_policies_no_overlapp_7() -> + [{doc,""}]. +certificate_different_policies_no_overlapp_7(Config) when is_list(Config) -> + run([{"4.8.7", "Different Policies Test7 EE", + {bad_cert, + {policy_requirement_not_met, + {{explicit_policy, 0}, + {policy_set, []}}}}} + ]). + + +certificate_different_policies_no_overlapp_8() -> + [{doc,""}]. +certificate_different_policies_no_overlapp_8(Config) when is_list(Config) -> + run([{"4.8.8", "Different Policies Test8 EE", + {bad_cert, + {policy_requirement_not_met, + {{explicit_policy, 0}, + {policy_set, []}}}}} + ]). + +certificate_different_policies_no_overlapp_9() -> + [{doc,""}]. +certificate_different_policies_no_overlapp_9(Config) when is_list(Config) -> + run([{"4.8.9", "Different Policies Test9 EE", + {bad_cert, + {policy_requirement_not_met, + {{explicit_policy, 0}, + {policy_set, []}}}}} + ]). + +certificate_all_same_policies() -> + [{doc,"Certificate all same policies tests"}]. +certificate_all_same_policies(Config) when is_list(Config) -> + run([{"4.8.10.1", "All Certificates Same Policies Test10 EE", ok}, + {"4.8.10.2", "All Certificates Same Policies Test10 EE", ok}, + {"4.8.10.3", "All Certificates Same Policies Test10 EE", ok}]). + +certificate_all_any_policy() -> + [{doc,"Every certificate in the path asserts the special policy anyPolicy"}]. +certificate_all_any_policy(Config) when is_list(Config) -> + run([{"4.8.11.1", "All Certificates anyPolicy Test11 EE", ok}, + {"4.8.11.2", "All Certificates anyPolicy Test11 EE", ok}]). + +certificate_different_policies() -> + [{doc,"Every certificate in the path asserts the special policy anyPolicy"}]. +certificate_different_policies(Config) when is_list(Config) -> + run([{"4.8.12", "Different Policies Test12 EE", {bad_cert, + {policy_requirement_not_met, + {{explicit_policy, 0}, + {policy_set, []}}}}}]). +certificate_all_same_policies_13() -> + [{doc,"In this test, every certificate in the path asserts the same policies, NIST-test-policy-1, " + "NIST-testpolicy-2, and NIST-test-policy-3"}]. +certificate_all_same_policies_13(Config) when is_list(Config) -> + run([{"4.8.13.1", "All Certificates Same Policies Test13 EE", ok}, + {"4.8.13.2", "All Certificates Same Policies Test13 EE", ok}, + {"4.8.13.3", "All Certificates Same Policies Test13 EE", ok} + ]). + +certificate_any_policy() -> + [{doc,"In this test, the intermediate certificate asserts anyPolicy and the end entity certificate " + "asserts NIST-test-policy-1"}]. +certificate_any_policy(Config) when is_list(Config) -> + run([{"4.8.14.1", "AnyPolicy Test14 EE", ok}, + {"4.8.14.2", "AnyPolicy Test14 EE", + {bad_cert, + {policy_requirement_not_met, + {{explicit_policy, 0}, + {policy_set, []}}}}} + ]). + +certificate_user_notice_qualifier_15() -> + [{doc, "In this test, the path consists of a single certificate. " + "The certificate asserts the policy NIST-testpolicy-1 and includes " + "a user notice policy qualifier."}]. +certificate_user_notice_qualifier_15(Config) when is_list(Config) -> + run([{"4.8.15", "User Notice Qualifier Test15 EE", ok}]). + +certificate_user_notice_qualifier_16() -> + [{doc, "In this test, the path consists of an intermediate certificate " + "and an end entity certificate. The intermediate certificate asserts " + "the policy NIST-test-policy-1. The end entity certificate asserts " + "both NIST-test-policy-1 and NIST-test-policy-2. Each policy in the " + "end entity certificate has a different user notice qualifier associated with it."}]. +certificate_user_notice_qualifier_16(Config) when is_list(Config) -> + run([{"4.8.16", "User Notice Qualifier Test16 EE", ok}]). + +certificate_user_notice_qualifier_17() -> + [{doc, "In this test, the path consists of an intermediate certificate and an end entity " + "certificate. The intermediate certificate asserts the policy NIST-test-policy-1. The " + "end entity certificate asserts anyPolicy. There is a user notice policy qualifier " + "associated with anyPolicy in the end entity certificate"}]. +certificate_user_notice_qualifier_17(Config) when is_list(Config) -> + run([{"4.8.17", "User Notice Qualifier Test17 EE", ok}]). + +certificate_user_notice_qualifier_18() -> + [{doc, "In this test, the intermediate certificate asserts policies" + "NIST-test-policy-1 and NIST-test-policy-2. The end certificate " + "asserts NIST-test-policy-1 and anyPolicy. Each of the policies in the end ", + "entity certificate asserts a different user notice policy qualifier. " + "If possible, it is recommended that the certification path in this " + "test be validated using the following inputs"}]. +certificate_user_notice_qualifier_18(Config) when is_list(Config)-> + run([{"4.8.18.1", "User Notice Qualifier Test18 EE", ok}, + {"4.8.18.2", "User Notice Qualifier Test18 EE", ok} + ]). + +certificate_user_notice_qualifier_19() -> + [{doc, "In this test, the path consists of a single certificate." + "The certificate asserts the policy NIST-testpolicy-1 and " + "includes a user notice policy qualifier. The user notice qualifier contains explicit text " + "that is longer than 200 bytes. "}]. +certificate_user_notice_qualifier_19(Config) when is_list(Config)-> + run([{"4.8.19", "User Notice Qualifier Test19 EE", ok}]). + +certificate_cps_pointer_qualifier() -> + [{doc, "In this test, the path consists of an intermediate certificate and an end entity " + "certificate, both of which assert the policy NIST-test-policy-1. There is a CPS pointer " + "policy qualifier associated with NIST-test-policy-1 in the end entity certificate. "}]. +certificate_cps_pointer_qualifier(Config) when is_list(Config)-> + run([{"4.8.20", "CPS Pointer Qualifier Test20 EE", ok}]). + + + +%%-----------------------------Require explicit policy ------------------------- + +require_explicit_valid_empty() -> + [{doc, "The path should validate successfully since the explicit-policyindicator is not set"}]. +require_explicit_valid_empty(Config) when is_list(Config)-> + run([{ "4.9.1", "Valid requireExplicitPolicy Test1 EE", ok}, + { "4.9.2", "Valid requireExplicitPolicy Test2 EE ", ok} + ]). + +require_explicit_valid() -> + [{doc, "The path should validate successfully (as long as the initial-policy-set " + "is either any-policy or otherwise includes NIST-test-policy-1) since " + "the user-constrained-policy-set is not empty."}]. +require_explicit_valid(Config) when is_list(Config)-> + run([{ "4.9.4", "Valid requireExplicitPolicy Test4 EE ", ok} + ]). + +require_explicit_invalid() -> + [{doc, "The path should not validate successfully since the explicit-policyindicator is set " + "and the authorities-constrained-policy-set is empty. "}]. +require_explicit_invalid(Config) when is_list(Config)-> + run([{ "4.9.3", "Invalid requireExplicitPolicy Test3 EE", + {bad_cert, + {policy_requirement_not_met, + {{explicit_policy,0},{policy_set,[]}}}}}, + {"4.9.5", "Invalid requireExplicitPolicy Test5 EE", + {bad_cert, + {policy_requirement_not_met, + {{explicit_policy,0},{policy_set,[]}}}}} + ]). +require_explicit_valid_selfissued() -> + [{doc, "The path should validate successfully since the explicit-policyindicator is not set"}]. +require_explicit_valid_selfissued(Config) when is_list(Config)-> + run([{ "4.9.6", "Valid Self-Issued requireExplicitPolicy Test6 EE", ok} + ]). + +require_explicit_invalid_selfissued() -> + [{doc, "The path should not validate successfully since the explicit-policyindicator " + "is set and the authorities-constrained-policy-set is empty"}]. +require_explicit_invalid_selfissued(Config) when is_list(Config)-> + run([{ "4.9.7", "Invalid Self-Issued requireExplicitPolicy Test7 EE", + {bad_cert, + {policy_requirement_not_met, + {{explicit_policy,0},{policy_set,[]}}}}}, + { "4.9.8", "Invalid Self-Issued requireExplicitPolicy Test8 EE", + {bad_cert, + {policy_requirement_not_met, + {{explicit_policy,0},{policy_set,[]}}}}} + ]). %%----------------------------------------------------------------------------- -certificate_policies() -> - [{doc,"Not supported yet"}]. -certificate_policies(Config) when is_list(Config) -> - run(certificate_policies_tests()). -%%----------------------------------------------------------------------------- -require_explicit_policy() -> - [{doc,"Not supported yet"}]. -require_explicit_policy(Config) when is_list(Config) -> - run(require_explicit_policy_tests()). -%%----------------------------------------------------------------------------- -policy_mappings() -> - [{doc,"Not supported yet"}]. -policy_mappings(Config) when is_list(Config) -> - run(policy_mappings_tests()). -%%----------------------------------------------------------------------------- -inhibit_policy_mapping() -> - [{doc,"Not supported yet"}]. -inhibit_policy_mapping(Config) when is_list(Config) -> - run(inhibit_policy_mapping_tests()). -%%----------------------------------------------------------------------------- -inhibit_any_policy() -> - [{doc,"Not supported yet"}]. -inhibit_any_policy(Config) when is_list(Config) -> - run(inhibit_any_policy_tests()). + +valid_policy_mapping() -> + [{doc, ""}]. +valid_policy_mapping(Config) when is_list(Config)-> + run([{"4.10.1.1", "Valid Policy Mapping Test1 EE", ok}, + {"4.10.1.2", "Valid Policy Mapping Test1 EE", + {bad_cert, + {policy_requirement_not_met, + {{explicit_policy,0},{policy_set,[]}}}}}, + {"4.10.1.3", "Valid Policy Mapping Test1 EE", + {bad_cert, + {policy_requirement_not_met, + {{explicit_policy,0},{policy_set,[]}}}}} + ]). + +invalid_policy_mapping_2() -> + [{doc, ""}]. +invalid_policy_mapping_2(Config) when is_list(Config)-> + run([{"4.10.2.1", "Invalid Policy Mapping Test2 EE", + {bad_cert, + {policy_requirement_not_met, + {{explicit_policy,0},{policy_set,[]}}}}}, + {"4.10.2.2", "Invalid Policy Mapping Test2 EE", + {bad_cert, + {policy_requirement_not_met, + {{explicit_policy,0},{policy_set,[]}}}}} + ]). + +valid_policy_mapping_3() -> + [{doc, ""}]. +valid_policy_mapping_3(Config) when is_list(Config)-> + run([{"4.10.3.1", "Valid Policy Mapping Test3 EE", + {bad_cert, + {policy_requirement_not_met, + {{explicit_policy,0},{policy_set,[]}}}}}, + { "4.10.3.2", "Valid Policy Mapping Test3 EE", ok} + ]). + +invalid_policy_mapping_4() -> + [{doc, ""}]. +invalid_policy_mapping_4(Config) when is_list(Config)-> + run([{"4.10.4", "Invalid Policy Mapping Test4 EE", + {bad_cert, + {policy_requirement_not_met, + {{explicit_policy,0},{policy_set,[]}}}}} + ]). + +valid_policy_mapping_5() -> + [{doc, ""}]. +valid_policy_mapping_5(Config) when is_list(Config)-> + run([{"4.10.5.1", "Valid Policy Mapping Test5 EE", ok}, + {"4.10.5.2", "Valid Policy Mapping Test5 EE", + {bad_cert, + {policy_requirement_not_met, + {{explicit_policy,0},{policy_set,[]}}}}} + ]). + +valid_policy_mapping_6() -> + [{doc, ""}]. +valid_policy_mapping_6(Config) when is_list(Config)-> + run([{"4.10.6.1", "Valid Policy Mapping Test6 EE", ok}, + {"4.10.6.2", "Valid Policy Mapping Test6 EE", + {bad_cert, + {policy_requirement_not_met, + {{explicit_policy,0},{policy_set,[]}}}}} + ]). + +invalid_policy_mapping_7() -> + [{doc, "In this test, the intermediate certificate includes a policyMappings extension " + "that includes a mapping in which the issuerDomainPolicy is anyPolicy. The intermediate " + "certificate also includes a critical policyConstraints extension with requireExplicitPolicy " + "set to 0. "}]. +invalid_policy_mapping_7(Config) when is_list(Config)-> + run([{"4.10.7", "Invalid Mapping From anyPolicy Test7 EE", + {bad_cert, + {invalid_policy_mapping, + #'PolicyMappings_SEQOF'{ + issuerDomainPolicy = ?anyPolicy, + subjectDomainPolicy = oidify(?NIST1) + }}}} + ]). +invalid_policy_mapping_8() -> + [{doc, "In this test, the intermediate certificate includes a policyMappings " + "extension that includes a mapping in which the subjectDomainPolicy is anyPolicy. " + "The intermediate certificate also includes a critical policyConstraints extension with " + "requireExplicitPolicy set to 0. "}]. +invalid_policy_mapping_8(Config) when is_list(Config)-> + run([{"4.10.8", "Invalid Mapping To anyPolicy Test8 EE", + {bad_cert, + {invalid_policy_mapping, + #'PolicyMappings_SEQOF'{ + issuerDomainPolicy = oidify(?NIST1), + subjectDomainPolicy = ?anyPolicy}}}} + ]). + +valid_policy_mapping_9() -> + [{doc, ""}]. +valid_policy_mapping_9(Config) when is_list(Config)-> + run([{"4.10.9", "Valid Policy Mapping Test9 EE", ok} + ]). + +invalid_policy_mapping_10() -> + [{doc, ""}]. +invalid_policy_mapping_10(Config) when is_list(Config)-> + run([{"4.10.10", "Invalid Policy Mapping Test10 EE", + {bad_cert, + {policy_requirement_not_met, + {{explicit_policy,0},{policy_set,[]}}}}} + ]). + +valid_policy_mapping_11() -> + [{doc, ""}]. +valid_policy_mapping_11(Config) when is_list(Config)-> + run([{"4.10.11", "Valid Policy Mapping Test11 EE", ok} + ]). + +valid_policy_mapping_12() -> + [{doc, ""}]. +valid_policy_mapping_12(Config) when is_list(Config)-> + run([{"4.10.12.1", "Valid Policy Mapping Test12 EE", ok}, + {"4.10.12.2", "Valid Policy Mapping Test12 EE", ok} + ]). + +valid_policy_mapping_13() -> + [{doc, ""}]. +valid_policy_mapping_13(Config) when is_list(Config)-> + run([{"4.10.13.1", "Valid Policy Mapping Test13 EE", ok}, + {"4.10.13.2", "Valid Policy Mapping Test13 EE", ok} + ]). + +valid_policy_mapping_14() -> + [{doc, ""}]. +valid_policy_mapping_14(Config) when is_list(Config)-> + run([{ "4.10.14", "Valid Policy Mapping Test14 EE", ok} + ]). + + +%%-------------------Inhibit policy mapping tests ----------------------------- + +inhibit_mapping_invalid() -> + [{doc, ""}]. +inhibit_mapping_invalid(Config) when is_list(Config)-> + run([{ "4.11.1", "Invalid inhibitPolicyMapping Test1 EE", + {bad_cert, + {policy_requirement_not_met, + {{explicit_policy,0},{policy_set,[]}}}}}, + { "4.11.3", "Invalid inhibitPolicyMapping Test3 EE", + {bad_cert, + {policy_requirement_not_met, + {{explicit_policy,0},{policy_set,[]}}}}}, + { "4.11.5", "Invalid inhibitPolicyMapping Test5 EE ", + {bad_cert, + {policy_requirement_not_met, + {{explicit_policy,0},{policy_set,[]}}}}}, + { "4.11.6", "Invalid inhibitPolicyMapping Test6 EE", + {bad_cert, + {policy_requirement_not_met, + {{explicit_policy,0},{policy_set,[]}}}}} + ]). + +inhibit_mapping_valid() -> + [{doc," "}]. +inhibit_mapping_valid(Config) when is_list(Config) -> + run([{ "4.11.2", "Valid inhibitPolicyMapping Test2 EE", ok}, + { "4.11.4", "Valid inhibitPolicyMapping Test4 EE", ok} + ]). + +inhibit_mapping_valid_selfissued() -> + [{doc, ""}]. +inhibit_mapping_valid_selfissued(Config) when is_list(Config)-> + run([{ "4.11.7", "Valid Self-Issued inhibitPolicyMapping Test7 EE", ok} + ]). + +inhibit_mapping_invalid_selfissued() -> + [{doc, ""}]. +inhibit_mapping_invalid_selfissued(Config) when is_list(Config)-> + run([{ "4.11.8", "Invalid Self-Issued inhibitPolicyMapping Test8 EE", + {bad_cert, + {policy_requirement_not_met, + {{explicit_policy,0},{policy_set,[]}}}}}, + { "4.11.9", "Invalid Self-Issued inhibitPolicyMapping Test9 EE", + {bad_cert, + {policy_requirement_not_met, + {{explicit_policy,0},{policy_set,[]}}}}}, + { "4.11.10", "Invalid Self-Issued inhibitPolicyMapping Test10 EE", + {bad_cert, + {policy_requirement_not_met, + {{explicit_policy,0},{policy_set,[]}}}}}, + { "4.11.11", "Invalid Self-Issued inhibitPolicyMapping Test11 EE", + {bad_cert, + {policy_requirement_not_met, + {{explicit_policy,0},{policy_set,[]}}}}} + ]). + +%%---------------------- Inhibit any policy tests ------------------------------ + +inhibit_any_invalid_empty() -> + [{doc, ""}]. +inhibit_any_invalid_empty(Config) when is_list(Config)-> + run([{ "4.12.1", "Invalid inhibitAnyPolicy Test1 EE ", + {bad_cert, + {policy_requirement_not_met, + {{explicit_policy,0},{policy_set,[]}}}}}, + { "4.12.6", "Invalid inhibitAnyPolicy Test6 EE ", + {bad_cert, + {policy_requirement_not_met, + {{explicit_policy,0},{policy_set,[]}}}}} + ]). + +inhibit_any_valid() -> + [{doc, ""}]. +inhibit_any_valid(Config) when is_list(Config)-> + run([{ "4.12.2", "Valid inhibitAnyPolicy Test2 EE", ok}, + { "4.12.3.1", "inhibitAnyPolicy Test3 EE", ok}, + { "4.12.3.2", "inhibitAnyPolicy Test3 EE", + {bad_cert, + {policy_requirement_not_met, + {{explicit_policy,0},{policy_set,[]}}}}} + ]). + +inhibit_any_invalid() -> + [{doc, " "}]. +inhibit_any_invalid(Config) when is_list(Config)-> + run([{ "4.12.4", "Invalid inhibitAnyPolicy Test4 EE", + {bad_cert, + {policy_requirement_not_met, + {{explicit_policy,0},{policy_set,[]}}}}}, + {"4.12.5", "Invalid inhibitAnyPolicy Test5 EE", + {bad_cert, + {policy_requirement_not_met, + {{explicit_policy,0},{policy_set,[]}}}}} + ]). +inhibit_any_valid_selfissued() -> + [{doc, ""}]. +inhibit_any_valid_selfissued(Config) when is_list(Config)-> + run([{ "4.12.7", "Valid Self-Issued inhibitAnyPolicy Test7 EE", ok}, + { "4.12.9", "Valid Self-Issued inhibitAnyPolicy Test9 EE", + {bad_cert, + {policy_requirement_not_met, + {{explicit_policy,0},{policy_set,[]}}}}} + ]). + +inhibit_any_invalid_selfissued() -> + [{doc, ""}]. +inhibit_any_invalid_selfissued(Config) when is_list(Config)-> + run([{ "4.12.8", "Invalid Self-Issued inhibitAnyPolicy Test8 EE", + {bad_cert, + {policy_requirement_not_met, + {{explicit_policy,0},{policy_set,[]}}}}}, + { "4.12.10", "Invalid Self-Issued inhibitAnyPolicy Test10 EE ", + {bad_cert, + {policy_requirement_not_met, + {{explicit_policy,0},{policy_set,[]}}}}} + ]). + %%-------------------------------name_constraints---------------------------------------------- valid_DN_name_constraints() -> @@ -680,10 +1323,10 @@ invalid_uri_name_constraints(Config) when is_list(Config) -> delta_without_crl() -> [{doc,"Delta CRL tests"}]. delta_without_crl(Config) when is_list(Config) -> - run([{ "4.15.1", "Invalid deltaCRLIndicator No Base Test1 EE",{bad_cert, - revocation_status_undetermined}}, - {"4.15.10", "Invalid delta-CRL Test10 EE", {bad_cert, - revocation_status_undetermined}}]). + run([{ "4.15.1", "Invalid deltaCRLIndicator No Base Test1 EE",{bad_cert, + revocation_status_undetermined}}, + {"4.15.10", "Invalid delta-CRL Test10 EE", {bad_cert, + revocation_status_undetermined}}]). valid_delta_crls() -> [{doc,"Delta CRL tests"}]. valid_delta_crls(Config) when is_list(Config) -> @@ -722,12 +1365,12 @@ invalid_distribution_points() -> invalid_distribution_points(Config) when is_list(Config) -> run([{ "4.14.2", "Invalid distributionPoint Test2 EE", {bad_cert,{revoked, keyCompromise}}}, { "4.14.3", "Invalid distributionPoint Test3 EE", {bad_cert, - revocation_status_undetermined}}, + revocation_status_undetermined}}, { "4.14.6", "Invalid distributionPoint Test6 EE", {bad_cert,{revoked, keyCompromise}}}, { "4.14.8", "Invalid distributionPoint Test8 EE", {bad_cert, - revocation_status_undetermined}}, + revocation_status_undetermined}}, { "4.14.9", "Invalid distributionPoint Test9 EE", {bad_cert, - revocation_status_undetermined}} + revocation_status_undetermined}} ]). valid_only_contains() -> @@ -829,7 +1472,7 @@ unknown_not_critical_extension(Config) when is_list(Config) -> %%-------------------------------------------------------------------- -spec run([tuple()]) -> ok. -run(Tests) -> +run(Tests) -> [TA] = read_certs("Trust Anchor Root Certificate"), run(Tests, TA). @@ -842,23 +1485,27 @@ run(Tests) -> CertificateBodies :: [binary()]. run({Chap, Test, Result}, TA) -> run({Chap, Test, Result, read_certs(Test)}, TA); - run({Chap, Test, Result, CertsBody}, TA) -> + TestStr = lists:flatten(io_lib:format("Running ~p ~p ~n", [Chap, Test])), + ct:log("~s", [TestStr]), CertChain = cas(Chap) ++ CertsBody, Options = path_validation_options(Chap), try public_key:pkix_path_validation(TA, CertChain, Options) of - {Result, _} -> ok; + {Result, {_, PolicySet}} -> + validate_policy_set(Chap, PolicySet); {error,Result} when Result =/= ok -> - ok; + ok; {error, Error} -> ?error(" ~p ~p~n Expected ~p got ~p ~n", [Chap, Test, Result, Error]), fail; {ok, _OK} when Result =/= ok -> - ?error(" ~p ~p~n Expected ~p got ~p ~n", [Chap, Test, Result, ok]), + ?error(" ~p ~p~n Expected ~p got ~p ~n", [Chap, Test, Result, _OK]), fail catch Type:Reason:Stack -> - io:format("Crash ~p:~p in ~p~n",[Type,Reason,Stack]), - io:format(" ~p ~p Expected ~p ~n", [Chap, Test, Result]), + Str1 = lists:flatten(io_lib:format("Crash ~p:~p in ~p~n",[Type,Reason,Stack])), + Str2 = lists:flatten(io_lib:format(" ~p ~p Expected ~p ~n", [Chap, Test, Result])), + erlang:display(Str1), + erlang:display(Str2), exit(crash) end; @@ -867,21 +1514,22 @@ run(Tests,TA) when is_list(Tests) -> ok. path_validation_options(Chap) -> - case needs_crl_options(Chap) of - true -> - crl_options(Chap); - false -> - Fun = - fun(_,{bad_cert, _} = Reason, _) -> - {fail, Reason}; - (_,{extension, _}, UserState) -> - {unknown, UserState}; - (_, Valid, UserState) when Valid == valid; - Valid == valid_peer -> - {valid, UserState} - end, - [{verify_fun, {Fun, []}}] - end. + Options = case needs_crl_options(Chap) of + true -> + crl_options(Chap); + false -> + Fun = + fun(_,{bad_cert, _} = Reason, _) -> + {fail, Reason}; + (_,{extension, _}, UserState) -> + {unknown, UserState}; + (_, Valid, UserState) when Valid == valid; + Valid == valid_peer -> + {valid, UserState} + end, + [{verify_fun, {Fun, []}}] + end, + policy_options(Chap, Options). -spec read_certs(TestCase :: string()) -> [CertificateContent :: binary()]. read_certs(Test) -> @@ -1015,14 +1663,14 @@ crl_path_db([{_, CRL} |CRLs], [Path | Paths], Acc) -> crl_info(_, [], Acc) -> Acc; crl_info(OtpCert, [{_, #'CertificateList'{tbsCertList = - #'TBSCertList'{issuer = Issuer, - crlExtensions = CRLExtensions}}} - = CRL | Rest], Acc) -> + #'TBSCertList'{issuer = Issuer, + crlExtensions = CRLExtensions}}} + = CRL | Rest], Acc) -> OtpTBSCert = OtpCert#'OTPCertificate'.tbsCertificate, Extensions = OtpTBSCert#'OTPTBSCertificate'.extensions, ExtList = pubkey_cert:extensions_list(CRLExtensions), DPs = case pubkey_cert:select_extension(?'id-ce-cRLDistributionPoints', Extensions) of - #'Extension'{extnValue = Value} -> + #'Extension'{extnValue = Value} -> lists:foldl(fun(Point, Acc0) -> Dp = pubkey_cert_records:transform(Point, decode), IDP = pubkey_cert:select_extension(?'id-ce-issuingDistributionPoint', @@ -1090,7 +1738,7 @@ trusted_cert_and_path(_, #'CertificateList'{} = CRL, _, PathDb) -> case lists:keysearch(CRL, 1, PathDb) of {_, {CRL, [ _| _] = Path}} -> - {ok, TrustedCert, [TrustedDERCert | Path]}; + {ok, TrustedCert, [TrustedDERCert | Path]}; {_, {CRL, []}} -> {ok, TrustedCert, [TrustedDERCert]} end. @@ -1107,7 +1755,7 @@ cas(Chap) -> CAS = intermidiate_cas(Chap), lists:foldl(fun([], Acc) -> Acc; - (CA, Acc) -> + (CA, Acc) -> [CACert] = read_certs(CA), [CACert | Acc] end, [], CAS). @@ -1125,8 +1773,12 @@ intermidiate_cas(Chap) when Chap == "4.1.1"; Chap == "4.3.3"; Chap == "4.3.4"; Chap == "4.3.5"; - Chap == "4.4.3" - -> + Chap == "4.4.3"; + Chap == "4.8.1.1"; + Chap == "4.8.1.2"; + Chap == "4.8.1.3"; + Chap == "4.8.1.4"; + Chap == "4.8.20"-> ["Good CA Cert"]; intermidiate_cas(Chap) when Chap == "4.1.2" -> @@ -1140,12 +1792,12 @@ intermidiate_cas(Chap) when Chap == "4.1.5" -> ["DSA Parameters Inherited CA Cert", "DSA CA Cert"]; intermidiate_cas(Chap) when Chap == "4.2.1"; - Chap == "4.2.5" -> + Chap == "4.2.5" -> ["Bad notBefore Date CA Cert"]; intermidiate_cas(Chap) when Chap == "4.16.1"; - Chap == "4.16.2" -> - ["Trust Anchor Root Certificate"]; + Chap == "4.16.2" -> + ["Trust Anchor Root Certificate"]; intermidiate_cas(Chap) when Chap == "4.3.2" -> ["Name Ordering CA Cert"]; @@ -1154,7 +1806,7 @@ intermidiate_cas(Chap) when Chap == "4.13.34"; Chap == "4.13.35" -> ["nameConstraints URI1 CA Cert"]; intermidiate_cas(Chap) when Chap == "4.13.36"; - Chap == "4.13.37" -> + Chap == "4.13.37" -> ["nameConstraints URI2 CA Cert"]; intermidiate_cas(Chap) when Chap == "4.13.30"; @@ -1164,13 +1816,13 @@ intermidiate_cas(Chap) when Chap == "4.13.30"; ["nameConstraints DNS1 CA Cert"]; intermidiate_cas(Chap) when Chap == "4.13.32"; - Chap == "4.13.33" -> + Chap == "4.13.33" -> ["nameConstraints DNS2 CA Cert"]; intermidiate_cas(Chap) when Chap == "4.13.27"; Chap == "4.13.28"; Chap == "4.13.29" -> - ["nameConstraints DN1 subCA3 Cert", + ["nameConstraints DN1 subCA3 Cert", "nameConstraints DN1 CA Cert"]; intermidiate_cas(Chap) when Chap == "4.13.21"; @@ -1205,7 +1857,7 @@ intermidiate_cas(Chap) when Chap == "4.5.4"; Chap == "4.5.5" -> ["Basic Self-Issued Old Key CA Cert"]; -intermidiate_cas(Chap) when Chap == "4.13.1"; +intermidiate_cas(Chap) when Chap == "4.13.1"; Chap == "4.13.2"; Chap == "4.13.3"; Chap == "4.13.4"; @@ -1252,78 +1904,78 @@ intermidiate_cas(Chap) when Chap == "4.13.19" -> "nameConstraints DN1 CA Cert"]; intermidiate_cas(Chap) when Chap == "4.7.1"; - Chap == "4.7.4" -> + Chap == "4.7.4" -> ["keyUsage Critical keyCertSign False CA Cert"]; intermidiate_cas(Chap) when Chap == "4.7.2"; - Chap == "4.7.5" -> + Chap == "4.7.5" -> ["keyUsage Not Critical keyCertSign False CA Cert"]; -intermidiate_cas(Chap) when Chap == "4.7.3" -> +intermidiate_cas(Chap) when Chap == "4.7.3" -> ["keyUsage Not Critical CA Cert"]; -intermidiate_cas(Chap) when Chap == "4.3.7" -> +intermidiate_cas(Chap) when Chap == "4.3.7" -> ["RFC3280 Mandatory Attribute Types CA Cert"]; -intermidiate_cas(Chap) when Chap == "4.3.8" -> +intermidiate_cas(Chap) when Chap == "4.3.8" -> ["RFC3280 Optional Attribute Types CA Cert"]; -intermidiate_cas(Chap) when Chap == "4.3.6" -> +intermidiate_cas(Chap) when Chap == "4.3.6" -> ["UIDCACert"]; -intermidiate_cas(Chap) when Chap == "4.6.4" -> +intermidiate_cas(Chap) when Chap == "4.6.4" -> ["basicConstraints Not Critical CA Cert"]; -intermidiate_cas(Chap) when Chap == "4.1.26" -> +intermidiate_cas(Chap) when Chap == "4.1.26" -> ["nameConstraints RFC822 CA3 Cert"]; -intermidiate_cas(Chap) when Chap == "4.3.9" -> +intermidiate_cas(Chap) when Chap == "4.3.9" -> ["UTF8String Encoded Names CA Cert"]; -intermidiate_cas(Chap) when Chap == "4.3.10" -> +intermidiate_cas(Chap) when Chap == "4.3.10" -> ["Rollover from PrintableString to UTF8String CA Cert"]; -intermidiate_cas(Chap) when Chap == "4.3.11" -> +intermidiate_cas(Chap) when Chap == "4.3.11" -> ["UTF8String Case Insensitive Match CA Cert"]; intermidiate_cas(Chap) when Chap == "4.6.7"; Chap == "4.6.8" - -> + -> ["pathLenConstraint0 CA Cert"]; -intermidiate_cas(Chap) when Chap == "4.6.13" -> +intermidiate_cas(Chap) when Chap == "4.6.13" -> [ "pathLenConstraint6 subsubsubCA41X Cert", - "pathLenConstraint6 subsubCA41 Cert", - "pathLenConstraint6 subCA4 Cert", + "pathLenConstraint6 subsubCA41 Cert", + "pathLenConstraint6 subCA4 Cert", "pathLenConstraint6 CA Cert"]; -intermidiate_cas(Chap) when Chap == "4.6.14" -> +intermidiate_cas(Chap) when Chap == "4.6.14" -> [ "pathLenConstraint6 subsubsubCA41X Cert", - "pathLenConstraint6 subsubCA41 Cert", - "pathLenConstraint6 subCA4 Cert", + "pathLenConstraint6 subsubCA41 Cert", + "pathLenConstraint6 subCA4 Cert", "pathLenConstraint6 CA Cert"]; -intermidiate_cas(Chap) when Chap == "4.6.15" -> - [ "pathLenConstraint0 Self-Issued CA Cert", - "pathLenConstraint0 CA Cert"]; +intermidiate_cas(Chap) when Chap == "4.6.15" -> + [ "pathLenConstraint0 Self-Issued CA Cert", + "pathLenConstraint0 CA Cert"]; -intermidiate_cas(Chap) when Chap == "4.6.17" -> +intermidiate_cas(Chap) when Chap == "4.6.17" -> ["pathLenConstraint1 Self-Issued subCA Cert", - "pathLenConstraint1 subCA Cert", - "pathLenConstraint1 Self-Issued CA Cert", + "pathLenConstraint1 subCA Cert", + "pathLenConstraint1 Self-Issued CA Cert", "pathLenConstraint1 CA Cert"]; intermidiate_cas(Chap) when Chap == "4.6.5"; - Chap == "4.6.6" -> - ["pathLenConstraint0 subCA Cert", - "pathLenConstraint0 CA Cert"]; + Chap == "4.6.6" -> + ["pathLenConstraint0 subCA Cert", + "pathLenConstraint0 CA Cert"]; intermidiate_cas(Chap) when Chap == "4.6.9"; - Chap == "4.6.10" -> + Chap == "4.6.10" -> ["pathLenConstraint6 subsubCA00 Cert", "pathLenConstraint6 subCA0 Cert", "pathLenConstraint6 CA Cert"]; intermidiate_cas(Chap) when Chap == "4.6.11"; - Chap == "4.6.12" -> + Chap == "4.6.12" -> ["pathLenConstraint6 subsubsubCA11X Cert", "pathLenConstraint6 subsubCA11 Cert", "pathLenConstraint6 subCA1 Cert", @@ -1340,7 +1992,13 @@ intermidiate_cas(Chap) when Chap == "4.4.1" -> intermidiate_cas(Chap) when Chap == "4.4.2" -> ["Revoked subCA Cert", "Good CA Cert"]; -intermidiate_cas(Chap) when Chap == "4.4.3" -> +intermidiate_cas(Chap) when Chap == "4.4.3"; + Chap == "4.8.1.1"; + Chap == "4.8.1.2"; + Chap == "4.8.1.3"; + Chap == "4.8.1.4"; + Chap == "4.8.16"; + Chap == "4.8.17"-> ["Good CA Cert"]; intermidiate_cas(Chap) when Chap == "4.4.4" -> @@ -1474,8 +2132,245 @@ intermidiate_cas(Chap) when Chap == "4.5.6"; Chap == "4.5.7" -> ["Basic Self-Issued CRL Signing Key CA Cert"]; intermidiate_cas(Chap) when Chap == "4.5.8" -> - ["Basic Self-Issued CRL Signing Key CRL Cert"]. - + ["Basic Self-Issued CRL Signing Key CRL Cert"]; +intermidiate_cas(Chap) when Chap == "4.8.2.1"; + Chap == "4.8.2.2" -> + ["No Policies CA Cert"]; +intermidiate_cas(Chap) when Chap == "4.8.3.1"; + Chap == "4.8.3.2"; + Chap == "4.8.3.3" -> + ["Policies P2 subCA Cert","Good CA Cert" + ]; +intermidiate_cas("4.8.4") -> + ["Good subCA Cert", "Good CA Cert" + ]; +intermidiate_cas("4.8.5") -> + ["Policies P2 subCA2 Cert", "Good CA Cert" + ]; +intermidiate_cas(Chap) when Chap == "4.8.6.1"; + Chap == "4.8.6.2"; + Chap == "4.8.6.3" -> + ["Policies P1234 subsubCAP123P12 Cert", + "Policies P1234 subCAP123 Cert", + "Policies P1234 CA Cert"]; + +intermidiate_cas("4.8.7") -> + ["Policies P123 subsubCAP12P1 Cert", + "Policies P123 subCAP12 Cert", + "Policies P123 CA Cert"]; +intermidiate_cas("4.8.8") -> + ["Policies P12 subsubCAP1P2 Cert", + "Policies P12 subCAP1 Cert", + "Policies P12 CA Cert" + ]; +intermidiate_cas("4.8.9") -> + ["Policies P123 subsubsubCAP12P2P1 Cert", + "Policies P123 subsubCAP12P2 Cert", + "Policies P123 subCAP12 Cert", + "Policies P123 CA Cert"]; +intermidiate_cas(Chap) when Chap == "4.8.10.1"; + Chap == "4.8.10.2"; + Chap == "4.8.10.3"; + Chap == "4.8.18.1"; + Chap == "4.8.18.2"-> + ["Policies P12 CA Cert"]; +intermidiate_cas(Chap) when Chap == "4.8.11.1"; + Chap == "4.8.11.2" -> + ["anyPolicy CA Cert"]; +intermidiate_cas("4.8.12") -> + ["Policies P3 CA Cert"]; + +intermidiate_cas(Chap) when Chap == "4.8.13.1"; + Chap == "4.8.13.2"; + Chap == "4.8.13.3" -> + ["Policies P123 CA Cert"]; +intermidiate_cas(Chap) when Chap == "4.8.14.1"; + Chap == "4.8.14.2" -> + ["anyPolicy CA Cert"]; + +intermidiate_cas(Chap) when Chap == "4.9.1" -> + ["requireExplicitPolicy10 subsubsubCA Cert", + "requireExplicitPolicy10 subsubCA Cert", + "requireExplicitPolicy10 subCA Cert", + "requireExplicitPolicy10 CA Cert" + ]; +intermidiate_cas(Chap) when Chap == "4.9.2" -> + ["requireExplicitPolicy5 subsubsubCA Cert", + "requireExplicitPolicy5 subsubCA Cert", + "requireExplicitPolicy5 subCA Cert", + "requireExplicitPolicy5 CA Cert" + ]; +intermidiate_cas(Chap) when Chap == "4.9.3" -> + ["requireExplicitPolicy4 subsubsubCA Cert", + "requireExplicitPolicy4 subsubCA Cert", + "requireExplicitPolicy4 subCA Cert", + "requireExplicitPolicy4 CA Cert" + ]; +intermidiate_cas(Chap) when Chap == "4.9.4" -> + ["requireExplicitPolicy0 subsubsubCA Cert", + "requireExplicitPolicy0 subsubCA Cert", + "requireExplicitPolicy0 subCA Cert", + "requireExplicitPolicy0 CA Cert" + ]; +intermidiate_cas(Chap) when Chap == "4.9.5" -> + ["requireExplicitPolicy7 subsubsubCARE2RE4 Cert", + "requireExplicitPolicy7 subsubCARE2RE4 Cert", + "requireExplicitPolicy7 subCARE2 Cert", + "requireExplicitPolicy7 CA Cert" + ]; +intermidiate_cas(Chap) when Chap == "4.9.6" -> + ["requireExplicitPolicy2 Self-Issued CA Cert", + "requireExplicitPolicy2 CA Cert"]; +intermidiate_cas(Chap) when Chap == "4.9.7" -> + ["requireExplicitPolicy2 subCA Cert", + "requireExplicitPolicy2 Self-Issued CA Cert", + "requireExplicitPolicy2 CA Cert" + ]; +intermidiate_cas(Chap) when Chap == "4.9.8" -> + ["requireExplicitPolicy2 Self-Issued subCA Cert", + "requireExplicitPolicy2 subCA Cert", + "requireExplicitPolicy2 Self-Issued CA Cert", + "requireExplicitPolicy2 CA Cert" + ]; +intermidiate_cas(Chap) when Chap == "4.8.15"; + Chap == "4.8.19" -> + []; +intermidiate_cas(Chap) when Chap == "4.10.1.1"; + Chap == "4.10.1.2"; + Chap == "4.10.1.3"; + Chap == "4.10.2.1"; + Chap == "4.10.2.2" -> + ["Mapping 1to2 CA Cert"]; +intermidiate_cas(Chap) when Chap == "4.10.3.1"; + Chap == "4.10.3.2"; + Chap == "4.10.4"-> + [ + "P12 Mapping 1to3 subsubCA Cert", + "P12 Mapping 1to3 subCA Cert", + "P12 Mapping 1to3 CA Cert" + ]; +intermidiate_cas(Chap) when Chap == "4.10.5.1"; + Chap == "4.10.5.2"; + Chap == "4.10.6.1"; + Chap == "4.10.6.2"-> + [ + "P1 Mapping 1to234 subCA Cert", + "P1 Mapping 1to234 CA Cert" + ]; +intermidiate_cas(Chap) when Chap == "4.10.7" -> + [ + "Mapping From anyPolicy CA Cert" + ]; +intermidiate_cas(Chap) when Chap == "4.10.8" -> + [ + "Mapping To anyPolicy CA Cert" + ]; +intermidiate_cas(Chap) when Chap == "4.10.9" -> + [ + "PanyPolicy Mapping 1to2 CA Cert" + ]; +intermidiate_cas(Chap) when Chap == "4.10.10"; + Chap == "4.10.11" -> + [ + "Good subCA PanyPolicy Mapping 1to2 CA Cert", + "Good CA Cert" + ]; +intermidiate_cas(Chap) when Chap == "4.10.12.1"; + Chap == "4.10.12.2" -> + [ + "P12 Mapping 1to3 CA Cert" + ]; +intermidiate_cas(Chap) when Chap == "4.10.13.1"; + Chap == "4.10.13.2"; + Chap == "4.10.14" -> + [ + "P1anyPolicy Mapping 1to2 CA Cert" + ]; +intermidiate_cas(Chap) when Chap == "4.11.1" -> + [ + "inhibitPolicyMapping0 subCA Cert", + "inhibitPolicyMapping0 CA Cert" + ]; +intermidiate_cas(Chap) when Chap == "4.11.2" -> + [ + "inhibitPolicyMapping1 P12 subCA Cert", + "inhibitPolicyMapping1 P12 CA Cert" + ]; +intermidiate_cas(Chap) when Chap == "4.11.3"; + Chap == "4.11.4" -> + [ + "inhibitPolicyMapping1 P12 subsubCA Cert", + "inhibitPolicyMapping1 P12 subCA Cert", + "inhibitPolicyMapping1 P12 CA Cert" + ]; +intermidiate_cas(Chap) when Chap == "4.11.5" -> + [ + "inhibitPolicyMapping5 subsubsubCA Cert", + "inhibitPolicyMapping5 subsubCA Cert", + "inhibitPolicyMapping5 subCA Cert", + "inhibitPolicyMapping5 CA Cert" + ]; +intermidiate_cas(Chap) when Chap == "4.11.6" -> + [ + "inhibitPolicyMapping1 P12 subsubCAIPM5 Cert", + "inhibitPolicyMapping1 P12 subCAIPM5 Cert", + "inhibitPolicyMapping1 P12 CA Cert" + ]; +intermidiate_cas(Chap) when Chap == "4.11.7" -> + [ + "inhibitPolicyMapping1 P1 subCA Cert", + "inhibitPolicyMapping1 P1 Self-Issued CA Cert", + "inhibitPolicyMapping1 P1 CA Cert" + ]; +intermidiate_cas(Chap) when Chap == "4.11.8"; + Chap == "4.11.9" -> + [ + "inhibitPolicyMapping1 P1 subsubCA Cert", + "inhibitPolicyMapping1 P1 subCA Cert", + "inhibitPolicyMapping1 P1 Self-Issued CA Cert ", + "inhibitPolicyMapping1 P1 CA Cert" + ]; +intermidiate_cas(Chap) when Chap == "4.11.10"; + Chap == "4.11.11" -> + [ + "inhibitPolicyMapping1 P1 Self-Issued subCA Cert", + "inhibitPolicyMapping1 P1 subCA Cert", + "inhibitPolicyMapping1 P1 Self-Issued CA Cert", + "inhibitPolicyMapping1 P1 CA Cert" + ]; +intermidiate_cas(Chap) when Chap == "4.12.1"; + Chap == "4.12.2" -> + ["inhibitAnyPolicy0 CA Cert"]; +intermidiate_cas(Chap) when Chap == "4.12.3.1"; + Chap == "4.12.3.2"; + Chap == "4.12.4" -> + ["inhibitAnyPolicy1 subCA1 Cert", + "inhibitAnyPolicy1 CA Cert"]; +intermidiate_cas(Chap) when Chap == "4.12.5" -> + ["inhibitAnyPolicy5 subsubCA Cert", + "inhibitAnyPolicy5 subCA Cert", + "inhibitAnyPolicy5 CA Cert"]; +intermidiate_cas(Chap) when Chap == "4.12.6" -> + ["inhibitAnyPolicy1 subCAIAP5 Cert", + "inhibitAnyPolicy1 CA Cert"]; +intermidiate_cas(Chap) when Chap == "4.12.7" -> + ["inhibitAnyPolicy1 subCA2 Cert", + "inhibitAnyPolicy1 Self-Issued CA Cert", + "inhibitAnyPolicy1 CA Cert"]; +intermidiate_cas(Chap) when Chap == "4.12.8" -> + ["inhibitAnyPolicy1 subsubCA2 Cert", + "inhibitAnyPolicy1 subCA2 Cert", + "inhibitAnyPolicy1 Self-Issued CA Cert", + "inhibitAnyPolicy1 CA Cert"]; +intermidiate_cas(Chap) when Chap == "4.12.9" -> + ["inhibitAnyPolicy1 Self-Issued subCA2 Cert", + "inhibitAnyPolicy1 subCA2 Cert", + "inhibitAnyPolicy1 Self-Issued CA Cert", + "inhibitAnyPolicy1 CA Cert"]; +intermidiate_cas(Chap) when Chap == "4.12.10" -> + ["inhibitAnyPolicy1 subCA2 Cert", + "inhibitAnyPolicy1 Self-Issued CA Cert", + "inhibitAnyPolicy1 CA Cert"]. %%%%%%%%%%%%%%% CRL mappings %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% crl_names("4.3.10") -> @@ -1487,123 +2382,362 @@ crl_names("4.4.2") -> crl_names("4.4.3") -> ["Trust Anchor Root CRL", "Good CA CRL", "Revoked subCA CRL"]; crl_names("4.4.4") -> - ["Trust Anchor Root CRL", "Bad CRL Signature CA CRL"]; + ["Trust Anchor Root CRL", "Bad CRL Signature CA CRL"]; crl_names("4.4.5") -> - ["Trust Anchor Root CRL", "Bad CRL Issuer Name CA CRL"]; + ["Trust Anchor Root CRL", "Bad CRL Issuer Name CA CRL"]; crl_names("4.4.6") -> - ["Trust Anchor Root CRL", "Wrong CRL CA CRL"]; + ["Trust Anchor Root CRL", "Wrong CRL CA CRL"]; crl_names("4.4.7") -> - ["Trust Anchor Root CRL", "Two CRLs CA Good CRL", "Two CRLs CA Bad CRL"]; + ["Trust Anchor Root CRL", "Two CRLs CA Good CRL", "Two CRLs CA Bad CRL"]; crl_names("4.4.8") -> - ["Trust Anchor Root CRL", "Unknown CRL Entry Extension CA CRL"]; + ["Trust Anchor Root CRL", "Unknown CRL Entry Extension CA CRL"]; crl_names(Chap) when Chap == "4.4.9"; - Chap == "4.4.10"-> - ["Trust Anchor Root CRL", "Unknown CRL Extension CA CRL"]; + Chap == "4.4.10"-> + ["Trust Anchor Root CRL", "Unknown CRL Extension CA CRL"]; crl_names("4.4.11") -> - ["Trust Anchor Root CRL", "Old CRL nextUpdate CA CRL"]; + ["Trust Anchor Root CRL", "Old CRL nextUpdate CA CRL"]; crl_names("4.4.12") -> - ["Trust Anchor Root CRL", "pre2000 CRL nextUpdate CA CRL"]; + ["Trust Anchor Root CRL", "pre2000 CRL nextUpdate CA CRL"]; crl_names("4.4.13") -> - ["Trust Anchor Root CRL", "GeneralizedTime CRL nextUpdate CA CRL"]; + ["Trust Anchor Root CRL", "GeneralizedTime CRL nextUpdate CA CRL"]; crl_names(Chap) when Chap == "4.4.14"; - Chap == "4.4.15"-> + Chap == "4.4.15"-> ["Trust Anchor Root CRL", "Negative Serial Number CA CRL"]; crl_names(Chap) when Chap == "4.4.16"; - Chap == "4.4.17"; - Chap == "4.4.18" -> + Chap == "4.4.17"; + Chap == "4.4.18" -> ["Trust Anchor Root CRL", "Long Serial Number CA CRL"]; crl_names(Chap)when Chap == "4.4.19"; - Chap == "4.4.20" -> + Chap == "4.4.20" -> ["Trust Anchor Root CRL", "Separate Certificate and CRL Keys CRL"]; crl_names("4.4.21") -> - ["Trust Anchor Root CRL", "Separate Certificate and CRL Keys CA2 CRL"]; + ["Trust Anchor Root CRL", "Separate Certificate and CRL Keys CA2 CRL"]; crl_names(Chap) when Chap == "4.5.1"; Chap == "4.5.2"-> - ["Trust Anchor Root CRL", "Basic Self-Issued New Key CA CRL"]; + ["Trust Anchor Root CRL", "Basic Self-Issued New Key CA CRL"]; crl_names(Chap) when Chap == "4.5.3"; - Chap == "4.5.4"; - Chap == "4.5.5" -> - ["Trust Anchor Root CRL", "Basic Self-Issued Old Key Self-Issued Cert CRL", - "Basic Self-Issued Old Key CA CRL"]; + Chap == "4.5.4"; + Chap == "4.5.5" -> + ["Trust Anchor Root CRL", "Basic Self-Issued Old Key Self-Issued Cert CRL", + "Basic Self-Issued Old Key CA CRL"]; crl_names(Chap) when Chap == "4.5.6"; Chap == "4.5.7"; Chap == "4.5.8" -> - ["Trust Anchor Root CRL", "Basic Self-Issued CRL Signing Key CRL Cert CRL", - "Basic Self-Issued CRL Signing Key CA CRL" - ]; + ["Trust Anchor Root CRL", "Basic Self-Issued CRL Signing Key CRL Cert CRL", + "Basic Self-Issued CRL Signing Key CA CRL" + ]; crl_names("4.7.4") -> - ["Trust Anchor Root CRL", "keyUsage Critical cRLSign False CA CRL"]; + ["Trust Anchor Root CRL", "keyUsage Critical cRLSign False CA CRL"]; crl_names("4.7.5") -> - ["Trust Anchor Root CRL", "keyUsage Not Critical cRLSign False CA CRL"]; + ["Trust Anchor Root CRL", "keyUsage Not Critical cRLSign False CA CRL"]; crl_names(Chap) when Chap == "4.14.1"; - Chap == "4.14.2"; - Chap == "4.14.3"; - Chap == "4.14.4" -> + Chap == "4.14.2"; + Chap == "4.14.3"; + Chap == "4.14.4" -> ["Trust Anchor Root CRL", "distributionPoint1 CA CRL"]; crl_names(Chap) when Chap == "4.14.5"; - Chap == "4.14.6"; - Chap == "4.14.7"; - Chap == "4.14.8"; - Chap == "4.14.9" -> + Chap == "4.14.6"; + Chap == "4.14.7"; + Chap == "4.14.8"; + Chap == "4.14.9" -> ["Trust Anchor Root CRL", "distributionPoint2 CA CRL"]; crl_names("4.14.10") -> - ["Trust Anchor Root CRL", "No issuingDistributionPoint CA CRL"]; + ["Trust Anchor Root CRL", "No issuingDistributionPoint CA CRL"]; crl_names("4.14.11") -> - ["Trust Anchor Root CRL", "onlyContainsUserCerts CA CRL"]; + ["Trust Anchor Root CRL", "onlyContainsUserCerts CA CRL"]; crl_names(Chap) when Chap == "4.14.12"; - Chap == "4.14.13" -> + Chap == "4.14.13" -> ["Trust Anchor Root CRL", "onlyContainsCACerts CA CRL"]; crl_names("4.14.14") -> ["Trust Anchor Root CRL", "onlyContainsAttributeCerts CA CRL"]; crl_names(Chap) when Chap == "4.14.15"; - Chap == "4.14.16" -> - ["Trust Anchor Root CRL", "onlySomeReasons CA1 compromise CRL", - "onlySomeReasons CA1 other reasons CRL"]; + Chap == "4.14.16" -> + ["Trust Anchor Root CRL", "onlySomeReasons CA1 compromise CRL", + "onlySomeReasons CA1 other reasons CRL"]; crl_names("4.14.17") -> - ["Trust Anchor Root CRL", - "onlySomeReasons CA2 CRL1", "onlySomeReasons CA2 CRL2"]; + ["Trust Anchor Root CRL", + "onlySomeReasons CA2 CRL1", "onlySomeReasons CA2 CRL2"]; crl_names("4.14.18") -> - ["Trust Anchor Root CRL", - "onlySomeReasons CA3 compromise CRL", "onlySomeReasons CA3 other reasons CRL"]; + ["Trust Anchor Root CRL", + "onlySomeReasons CA3 compromise CRL", "onlySomeReasons CA3 other reasons CRL"]; crl_names(Chap) when Chap == "4.14.19"; - Chap == "4.14.20"; - Chap == "4.14.21" -> - ["Trust Anchor Root CRL", "onlySomeReasons CA4 compromise CRL", - "onlySomeReasons CA4 other reasons CRL"]; + Chap == "4.14.20"; + Chap == "4.14.21" -> + ["Trust Anchor Root CRL", "onlySomeReasons CA4 compromise CRL", + "onlySomeReasons CA4 other reasons CRL"]; crl_names(Chap) when Chap == "4.14.22"; - Chap == "4.14.23"; - Chap == "4.14.24"; - Chap == "4.14.25"; - Chap == "4.14.26" -> - ["Trust Anchor Root CRL", "indirectCRL CA1 CRL"]; -crl_names("4.14.27") -> - ["Trust Anchor Root CRL", "Good CA CRL"]; - + Chap == "4.14.23"; + Chap == "4.14.24"; + Chap == "4.14.25"; + Chap == "4.14.26" -> + ["Trust Anchor Root CRL", "indirectCRL CA1 CRL"]; +crl_names(Chap) when Chap == "4.14.27"; + Chap == "4.8.1.1"; + Chap == "4.8.1.2"; + Chap == "4.8.1.3"; + Chap == "4.8.1.4"; + Chap == "4.8.16"; + Chap == "4.8.17"; + Chap == "4.8.20" -> + ["Trust Anchor Root CRL", "Good CA CRL"]; crl_names(Chap) when Chap == "4.14.28"; Chap == "4.14.29" -> ["Trust Anchor Root CRL", "indirectCRL CA3 CRL", "indirectCRL CA3 cRLIssuer CRL"]; crl_names("4.14.30") -> - ["Trust Anchor Root CRL", "indirectCRL CA4 cRLIssuer CRL"]; + ["Trust Anchor Root CRL", "indirectCRL CA4 cRLIssuer CRL"]; crl_names(Chap) when Chap == "4.14.31"; - Chap == "4.14.32"; - Chap == "4.14.33"; - Chap == "4.14.34"; - Chap == "4.14.35" -> - ["Trust Anchor Root CRL", "indirectCRL CA5 CRL"]; + Chap == "4.14.32"; + Chap == "4.14.33"; + Chap == "4.14.34"; + Chap == "4.14.35" -> + ["Trust Anchor Root CRL", "indirectCRL CA5 CRL"]; crl_names("4.15.1") -> - ["Trust Anchor Root CRL", "deltaCRLIndicator No Base CA CRL"]; + ["Trust Anchor Root CRL", "deltaCRLIndicator No Base CA CRL"]; crl_names(Chap) when Chap == "4.15.2"; - Chap == "4.15.3"; - Chap == "4.15.4"; - Chap == "4.15.5"; - Chap == "4.15.6"; - Chap == "4.15.7" -> + Chap == "4.15.3"; + Chap == "4.15.4"; + Chap == "4.15.5"; + Chap == "4.15.6"; + Chap == "4.15.7" -> ["Trust Anchor Root CRL", "deltaCRL CA1 CRL", "deltaCRL CA1 deltaCRL"]; crl_names(Chap) when Chap == "4.15.8"; - Chap == "4.15.9" -> - ["Trust Anchor Root CRL", "deltaCRL CA2 CRL", "deltaCRL CA2 deltaCRL"]; + Chap == "4.15.9" -> + ["Trust Anchor Root CRL", "deltaCRL CA2 CRL", "deltaCRL CA2 deltaCRL"]; crl_names("4.15.10") -> - ["Trust Anchor Root CRL", "deltaCRL CA3 CRL", "deltaCRL CA3 deltaCRL"]. + ["Trust Anchor Root CRL", "deltaCRL CA3 CRL", "deltaCRL CA3 deltaCRL"]; +crl_names(Chap) when Chap == "4.8.2.1"; + Chap == "4.8.2.2" -> + ["No Policies CA CRL"]; +crl_names(Chap) when Chap == "4.8.3.1"; + Chap == "4.8.3.2"; + Chap == "4.8.3.3" -> + ["Trust Anchor Root CRL", "Good CA CRL", "Policies P2 subCA CRL"]; +crl_names("4.8.4") -> + ["Trust Anchor Root CRL", "Good CA CRL", "Good subCA CRL"]; +crl_names("4.8.5") -> + ["Trust Anchor Root CRL", "Good CA CRL", "Policies P2 subCA2 CRL"]; +crl_names(Chap) when Chap == "4.8.6.1"; + Chap == "4.8.6.2"; + Chap == "4.8.6.3" -> + ["Trust Anchor Root CRL", "Policies P1234 CA CRL", + "Policies P1234 subCAP123 CRL", "Policies P1234 subsubCAP123P12 CRL"]; +crl_names("4.8.7") -> + ["Trust Anchor Root CRL", "Policies P123 CA CRL", + "Policies P123 subCAP12 CRL", "Policies P123 subsubCAP12P1 CRL"]; +crl_names("4.8.8") -> + ["Trust Anchor Root CRL", "Policies P12 CA CRL", + "Policies P12 subCAP1 CRL", "Policies P12 subsubCAP1P2 CRL"]; +crl_names("4.8.9") -> + ["Trust Anchor Root CRL", "Policies P123 CA CRL", + "Policies P123 subCAP12 CRL", "Policies P123 subsubCAP2P2 CRL", "Policies P123 subsubsubCAP12P2P1 CRL"]; +crl_names(Chap) when Chap == "4.8.10.1"; + Chap == "4.8.10.2"; + Chap == "4.8.10.3"; + Chap == "4.8.18.1"; + Chap == "4.8.18.2" -> + ["Policies P12 CA CRL"]; +crl_names(Chap) when Chap == "4.8.11.1"; + Chap == "4.8.11.2" -> + ["Trust Anchor Root CRL", "anyPolicy CA CRL"]; +crl_names("4.8.12") -> + ["Policies P3 CA CRL"]; +crl_names(Chap) when Chap == "4.8.13.1"; + Chap == "4.8.13.2"; + Chap == "4.8.13.3" -> + ["Policies Policies P123 CA CRL"]; +crl_names(Chap) when Chap == "4.8.14.1"; + Chap == "4.8.14.2" -> + ["anyPolicy CA CRL"]; +crl_names(Chap) when Chap == "4.8.15" -> + ["Trust Anchor Root CRL"]; + +crl_names(Chap) when Chap == "4.9.1" -> + ["Trust Anchor Root CRL", + "requireExplicitPolicy10 CA CRL" + "requireExplicitPolicy10 subCA CRL", + "requireExplicitPolicy10 subsubCA CRL", + "requireExplicitPolicy10 subsubsubCA CRL" + ]; +crl_names(Chap) when Chap == "4.9.2" -> + ["Trust Anchor Root CRL", + "requireExplicitPolicy5 CA CRL" + "requireExplicitPolicy5 subCA CRL", + "requireExplicitPolicy5 subsubCA CRL", + "requireExplicitPolicy5 subsubsubCA CRL" + ]; +crl_names(Chap) when Chap == "4.9.3" -> + ["Trust Anchor Root CRL", + "requireExplicitPolicy4 CA CRL" + "requireExplicitPolicy4 subCA CRL", + "requireExplicitPolicy4 subsubCA CRL", + "requireExplicitPolicy4 subsubsubCA CRL" + ]; +crl_names(Chap) when Chap == "4.9.4" -> + ["Trust Anchor Root CRL", + "requireExplicitPolicy0 CA CRL" + "requireExplicitPolicy0 subCA CRL", + "requireExplicitPolicy0 subsubCA CRL", + "requireExplicitPolicy0 subsubsubCA CRL" + ]; +crl_names(Chap) when Chap == "4.9.5" -> + ["Trust Anchor Root CRL", + "requireExplicitPolicy7 CA CRL" + "requireExplicitPolicy7 subCARE2 CRL ", + "requireExplicitPolicy7 subsubCARE2RE4 CRL", + "requireExplicitPolicy7 subsubsubCARE2RE4 CRL" + ]; +crl_names(Chap) when Chap == "4.9.6" -> + ["Trust Anchor Root CRL", + "requireExplicitPolicy2 CA CRL"]; +crl_names(Chap) when Chap == "4.9.7"; + Chap == "4.9.8" -> + ["Trust Anchor Root CRL", + "requireExplicitPolicy2 CA CRL", + "requireExplicitPolicy2 subCA CRL"]; +crl_names(Chap) when Chap == "4.10.1.1"; + Chap == "4.10.1.2"; + Chap == "4.10.1.3"; + Chap == "4.10.2.1"; + Chap == "4.10.2.2" -> + ["Trust Anchor Root CRL", + "Mapping 1to2 CA CRL"]; +crl_names(Chap) when Chap == "4.10.3.1"; + Chap == "4.10.3.2"; + Chap == "4.10.4" -> + ["Trust Anchor Root CRL", + "P12 Mapping 1to3 CA CRL", + "P12 Mapping 1to3 subCA CRL", + "P12 Mapping 1to3 subsubCA CRL" + ]; +crl_names(Chap) when Chap == "4.10.5.1"; + Chap == "4.10.5.2" -> + ["Trust Anchor Root CRL", + "P1 Mapping 1to234 CA CRL", + "P1 Mapping 1to234 subCA CRL" + ]; +crl_names(Chap) when Chap == "4.10.5.1"; + Chap == "4.10.5.2"; + Chap == "4.10.6.1"; + Chap == "4.10.6.2" -> + ["Trust Anchor Root CRL", + "P1 Mapping 1to234 CA CRL", + "P1 Mapping 1to234 subCA CRL" + ]; +crl_names(Chap) when Chap == "4.10.7" -> + ["Trust Anchor Root CRL", + "Mapping From anyPolicy CA CRL" + ]; +crl_names(Chap) when Chap == "4.10.8" -> + ["Trust Anchor Root CRL", + "Mapping To anyPolicy CA CRL" + ]; +crl_names(Chap) when Chap == "4.10.9" -> + ["Trust Anchor Root CRL", + "PannyPolicy Mapping 1to2 CA CRL" + ]; +crl_names(Chap) when Chap == "4.10.10"; + Chap == "4.10.11" -> + ["Trust Anchor Root CRL", + "Good CA CRL", + "Good subCA PannyPolicy Mapping 1to2 CA CRL" + ]; +crl_names(Chap) when Chap == "4.10.12" -> + ["Trust Anchor Root CRL", + "P12 Mapping 1to3 CA CRL" + ]; +crl_names(Chap) when Chap == "4.10.13.1"; + Chap == "4.10.13.2"; + Chap == "4.10.14" -> + ["Trust Anchor Root CRL", + "P1anyPolicy Mapping 1to2 CA CRL" + ]; +crl_names(Chap) when Chap == "4.11.1" -> + ["Trust Anchor Root CRL", + "inhibitPolicyMapping0 CA CRL", + "inhibitPolicyMapping0 subCA CRL" + ]; +crl_names(Chap) when Chap == "4.11.2" -> + ["Trust Anchor Root CRL", + "inhibitPolicyMapping1 P12 CA CRL", + "inhibitPolicyMapping1 P12 subCA CRL" + ]; +crl_names(Chap) when Chap == "4.11.3"; + Chap == "4.11.4" -> + ["Trust Anchor Root CRL", + "inhibitPolicyMapping1 P12 CA CRL", + "inhibitPolicyMapping1 P12 subCA CRL", + "inhibitPolicyMapping1 P12 subsubCA CRL" + ]; +crl_names(Chap) when Chap == "4.11.5" -> + ["Trust Anchor Root CRL", + "inhibitPolicyMapping5 CA CRL", + "inhibitPolicyMapping5 subCA CRL", + "inhibitPolicyMapping5 subsubCA CRL", + "inhibitPolicyMapping5 subsubsubCA CRL" + ]; +crl_names(Chap) when Chap == "4.11.6" -> + ["Trust Anchor Root CRL", + "inhibitPolicyMapping1 P12 CA CRL", + "inhibitPolicyMapping1 P12 subCAIPM5 CRL", + " inhibitPolicyMapping1 P12 subsubCAIPM5 CRL" + ]; +crl_names(Chap) when Chap == "4.11.7" -> + ["Trust Anchor Root CRL", + "inhibitPolicyMapping1 P1 CA CRL", + "inhibitPolicyMapping1 P1 subCA CRL" + ]; +crl_names(Chap) when Chap == "4.11.8"; + Chap == "4.11.9" -> + ["Trust Anchor Root CRL", + "inhibitPolicyMapping1 P1 CA CRL", + "inhibitPolicyMapping1 P1 subCA CRL", + "inhibitPolicyMapping1 P1 subsubCA" + ]; +crl_names(Chap) when Chap == "4.11.10"; + Chap == "4.11.11" -> + ["Trust Anchor Root CRL", + "inhibitPolicyMapping1 P1 CA CRL", + "inhibitPolicyMapping1 P1 subCA CRL"]; +crl_names(Chap) when Chap == "4.12.1"; + Chap == "4.12.2" -> + ["Trust Anchor Root CRL", + "inhibitAnyPolicy0 CA CRL"]; +crl_names(Chap) when Chap == "4.12.3.1"; + Chap == "4.12.3.2"; + Chap == "4.12.4" -> + ["Trust Anchor Root CRL", + "inhibitAnyPolicy1 CA CRL", + "inhibitAnyPolicy1 subCA1 CRL" + ]; +crl_names(Chap) when Chap == "4.12.5" -> + ["Trust Anchor Root CRL", + "inhibitAnyPolicy5 CA CRL", + "inhibitAnyPolicy5 subCA CRL", + "inhibitAnyPolicy5 subsubCA CRL" + ]; +crl_names(Chap) when Chap == "4.12.6" -> + ["Trust Anchor Root CRL", + "inhibitAnyPolicy1 CA CRL", + "inhibitAnyPolicy1 subCAIAP5 CRL" + ]; +crl_names(Chap) when Chap == "4.12.7" -> + ["Trust Anchor Root CRL", + "inhibitAnyPolicy1 CA CRL", + "nhibitAnyPolicy1 subCA2 CRL"]; +crl_names(Chap) when Chap == "4.12.8" -> + ["Trust Anchor Root CRL", + "inhibitAnyPolicy1 CA CRL", + "inhibitAnyPolicy1 subCA2 CRL" + "inhibitAnyPolicy1 subsubCA2 CRL" + ]; +crl_names(Chap) when Chap == "4.12.9"; + Chap == "4.12.10" -> + ["Trust Anchor Root CRL" + "inhibitAnyPolicy1 CA CRL", + "inhibitAnyPolicy1 subCA2 CRL"]; + +crl_names(_) -> + []. crl_root_cert() -> "Trust Anchor Root Certificate". @@ -1625,7 +2759,7 @@ crl_path("Separate Certificate and CRL Keys CA2 CRL") -> crl_path("Basic Self-Issued Old Key Self-Issued Cert CRL") -> ["Basic Self-Issued Old Key CA Cert"]; crl_path("Basic Self-Issued Old Key CA CRL") -> - ["Basic Self-Issued Old Key CA Cert", "Basic Self-Issued Old Key NewWithOld CA Cert"]; + ["Basic Self-Issued Old Key CA Cert", "Basic Self-Issued Old Key NewWithOld CA Cert"]; crl_path("Basic Self-Issued CRL Signing Key CRL Cert CRL") -> ["Basic Self-Issued CRL Signing Key CA Cert"]; @@ -1662,118 +2796,298 @@ crl_path(CRL) -> [Base ++ "Cert"]. crls(CRLS) -> - lists:foldl(fun([], Acc) -> + lists:foldl(fun([], Acc) -> Acc; (CRLFile, Acc) -> [CRL] = read_crls(CRLFile), [CRL | Acc] end, [], CRLS). +policy_options(Chap, Options) when Chap == "4.8.1.1"; + Chap == "4.8.2.2"; + Chap == "4.8.3.2"; + Chap == "4.8.7"; + Chap == "4.8.8"; + Chap == "4.8.9"; + Chap == "4.8.12"; + Chap == "4.8.15"; + Chap == "4.8.16"; + Chap == "4.8.17"; + Chap == "4.8.20"; + Chap == "4.9.3"; + Chap == "4.9.5"; + Chap == "4.9.7"; + Chap == "4.9.8"; + Chap == "4.12.1"; + Chap == "4.12.2"; + Chap == "4.8.10.1"; + Chap == "4.8.11.1" -> + [{explicit_policy, true} | Options]; +policy_options(Chap, Options) when Chap == "4.9.4"; + Chap == "4.8.1.2"; + Chap == "4.8.6.2"; + Chap == "4.8.10.2"; + Chap == "4.8.11.2"; + Chap == "4.8.13.1"; + Chap == "4.8.14.1"; + Chap == "4.8.18.1"; + Chap == "4.10.1.1"; + Chap == "4.10.3.1"; + Chap == "4.10.5.1"; + Chap == "4.10.6.1"; + Chap == "4.10.12.1"; + Chap == "4.10.13.2"; + Chap == "4.11.2"; + Chap == "4.11.7" -> + [{explicit_policy, true}, {policy_set, [?NIST1]} | Options]; +policy_options(Chap, Options) when Chap == "4.8.1.3"; + Chap == "4.8.6.3"; + Chap == "4.8.10.3"; + Chap == "4.8.13.2"; + Chap == "4.8.14.2"; + Chap == "4.8.18.2"; + Chap == "4.10.1.2"; + Chap == "4.10.3.2"; + Chap == "4.10.12.2"; + Chap == "4.11.4"-> + [{explicit_policy, true}, {policy_set, [?NIST2]} | Options]; +policy_options(Chap, Options) when Chap == "4.8.1.4" -> + [{explicit_policy, true}, {policy_set, [?NIST1, ?NIST2]} | Options]; +policy_options(Chap, Options) when Chap == "4.8.13.3"-> + [{explicit_policy, true}, {policy_set, [?NIST3]} | Options]; +policy_options(Chap, Options) when Chap == "4.8.1.4"; + Chap == "4.8.3.3"-> + [{explicit_policy, true}, {policy_set, [?NIST1, ?NIST2]} | Options]; +policy_options(Chap, Options) when Chap == "4.10.5.2"; + Chap == "4.10.6.2" -> + [{explicit_policy, true}, {policy_set, [?NIST6]} | Options]; +policy_options(Chap, Options) when Chap == "4.10.1.3" -> + [{explicit_policy, true}, {inhibit_policy_mapping, true} | Options]; +policy_options(Chap, Options) when Chap == "4.10.2.2"; + Chap == "4.12.3.2" -> + [{explicit_policy, true}, {inhibit_any_policy, true} | Options]; +policy_options(Chap, Options) when Chap == "4.10.10"; + Chap == "4.10.4"; + Chap == "4.12.4"; + Chap == "4.12.5"; + Chap == "4.12.8"; + Chap == "4.12.10"; + Chap == "4.11.1"; + Chap == "4.11.3"; + Chap == "4.11.5"; + Chap == "4.11.6"; + Chap == "4.11.8"; + Chap == "4.11.9"; + Chap == "4.11.10"; + Chap == "4.11.11" -> + [{explicit_policy, true} | Options]; +policy_options(_, Options) -> + Options. + +oidify(Oid) when is_tuple(Oid) -> + Oid; +oidify(Oid) when is_list(Oid) -> + Tokens = string:tokens(Oid, "$."), + OidList = [list_to_integer(StrInt) || StrInt <- Tokens], + list_to_tuple(OidList). + +validate_policy_set(Chap, Set) when Chap == "4.8.1.1"; + Chap == "4.8.1.2"; + Chap == "4.8.1.4"; + Chap == "4.8.6.1"; + Chap == "4.8.6.2"; + Chap == "4.12.7"; + Chap == "4.8.10.2"; + Chap == "4.8.13.1"; + Chap == "4.8.11.2"; + Chap == "4.8.14.1"; + Chap == "4.9.1"; + Chap == "4.9.2"; + Chap == "4.9.4"; + Chap == "4.9.6"; + Chap == "4.10.9"; + Chap == "4.10.11"; + Chap == "4.11.2"; + Chap == "4.11.7"; + Chap == "4.12.2"; + Chap == "4.12.3.1"; + Chap == "4.12.7" -> + validate_nodes([[{expected_policy_set,[?NIST1_OID]}, + {valid_policy, ?NIST1_OID}]], Set); + +validate_policy_set(Chap, []) when Chap == "4.8.2.1"; + Chap == "4.8.3.1"-> + true; +validate_policy_set(Chap, Set) when Chap == "4.8.10.1" -> + validate_nodes([[{expected_policy_set,[?NIST1_OID]}, + {valid_policy, ?NIST1_OID}], + [{expected_policy_set,[?NIST2_OID]}, + {valid_policy, ?NIST2_OID}] + ], Set); +validate_policy_set(Chap, Set) when Chap == "4.8.10.3"; + Chap == "4.8.13.2"; + Chap == "4.10.3.2"; + Chap == "4.11.4" -> + validate_nodes([[{expected_policy_set,[?NIST2_OID]}, + {valid_policy, ?NIST2_OID}]], Set); +validate_policy_set(Chap, Set) when Chap == "4.8.13.3" -> + validate_nodes([[{expected_policy_set,[?NIST3_OID]}, + {valid_policy, ?NIST3_OID}]], Set); +validate_policy_set("4.8.11.1", Set) -> + validate_nodes([[{expected_policy_set,[?anyPolicy]}, + {valid_policy, ?anyPolicy}]], Set); +validate_policy_set(Chap, Set) when Chap == "4.8.15"; + Chap == "4.8.16"; + Chap == "4.8.17"; + Chap == "4.8.19"; + Chap == "4.8.18.1"; + Chap == "4.8.20" -> + validate_nodes([[{expected_policy_set,[?NIST1_OID]}, + {valid_policy, ?NIST1_OID}]], Set), + validate_qualifiers(Chap, Set); +validate_policy_set(Chap, Set) when Chap == "4.10.1.1" -> + validate_nodes([[{expected_policy_set,[?NIST2_OID]}, + {valid_policy, ?NIST1_OID}]], Set); +validate_policy_set(Chap, Set) when Chap == "4.10.5.1"; + Chap == "4.10.6.1" -> + validate_nodes([[{expected_policy_set,[?NIST2_OID, ?NIST3_OID, ?NIST4_OID]}, + {valid_policy, ?NIST1_OID}]], Set); + +validate_policy_set(Chap, Set) when Chap == "4.10.12.1" -> + validate_nodes([[{expected_policy_set,[?NIST3_OID]}, + {valid_policy, ?NIST1_OID}] + ], Set), + validate_qualifiers(Chap, Set); +validate_policy_set(Chap, Set) when Chap == "4.8.18.2"; + Chap == "4.10.12.2" -> + validate_nodes([[{expected_policy_set,[?NIST2_OID]}, + {valid_policy, ?NIST2_OID}] + ], Set), + validate_qualifiers(Chap, Set); +validate_policy_set(Chap, Set) when Chap == "4.10.13.1" -> + validate_nodes([[{expected_policy_set,[?NIST2_OID]}, + {valid_policy, ?NIST1_OID}]], Set), + validate_qualifiers(Chap, Set); +validate_policy_set(Chap, Set) when Chap == "4.10.13.2" -> + validate_nodes([[{expected_policy_set,[?NIST2_OID]}, + {valid_policy, ?NIST1_OID}]], Set), + validate_qualifiers(Chap, Set); +validate_policy_set(Chap, Set) when Chap == "4.10.14" -> + validate_nodes([[{expected_policy_set,[?NIST1_OID]}, + {valid_policy, ?NIST1_OID}]], Set), + validate_qualifiers(Chap, Set); +validate_policy_set(_Chap, _Set) -> + ok. + +validate_nodes([], _) -> + true; +validate_nodes([Expected | Rest], Nodes) -> + do_validate_nodes(Expected, Nodes), + validate_nodes(Rest, Nodes). + + +do_validate_nodes(_, []) -> + true; +do_validate_nodes(Expected, [Node | Nodes]) -> + try validate_node(Expected, Node) of + true -> + true + catch _:_ -> + do_validate_nodes(Expected, Nodes) + end. -%% TODO: If we implement policy support -%% Certificate policy tests need special handling. They can have several -%% sub tests and we need to check the outputs are correct. - -certificate_policies_tests() -> - %%{ "4.8", "Certificate Policies" }, - [{"4.8.1.1", "All Certificates Same Policy Test1", "-policy anyPolicy -explicit_policy", "True", ?NIST1, ?NIST1, 0}, - {"4.8.1.2", "All Certificates Same Policy Test1", "-policy ?NIST1BasicSelfIssuedCRLSigningKeyCACert.pem -explicit_policy", "True", ?NIST1, ?NIST1, 0}, - {"4.8.1.3", "All Certificates Same Policy Test1", "-policy ?NIST2 -explicit_policy", "True", ?NIST1, "", 43}, - {"4.8.1.4", "All Certificates Same Policy Test1", "-policy ?NIST1 -policy ?NIST2 -explicit_policy", "True", ?NIST1, ?NIST1, 0}, - {"4.8.2.1", "All Certificates No Policies Test2", "-policy anyPolicy", "False", "", "", 0}, - {"4.8.2.2", "All Certificates No Policies Test2", "-policy anyPolicy -explicit_policy", "True", "", "", 43}, - {"4.8.3.1", "Different Policies Test3", "-policy anyPolicy", "False", "", "", 0}, - {"4.8.3.2", "Different Policies Test3", "-policy anyPolicy -explicit_policy", "True", "", "", 43}, - {"4.8.3.3", "Different Policies Test3", "-policy ?NIST1 -policy ?NIST2 -explicit_policy", "True", "", "", 43}, - {"4.8.4", "Different Policies Test4", "-policy anyPolicy", "True", "", "", 43}, - {"4.8.5", "Different Policies Test5", "-policy anyPolicy", "True", "", "", 43}, - {"4.8.6.1", "Overlapping Policies Test6", "-policy anyPolicy", "True", ?NIST1, ?NIST1, 0}, - {"4.8.6.2", "Overlapping Policies Test6", "-policy ?NIST1", "True", ?NIST1, ?NIST1, 0}, - {"4.8.6.3", "Overlapping Policies Test6", "-policy ?NIST2", "True", ?NIST1, "", 43}, - {"4.8.7", "Different Policies Test7", "-policy anyPolicy", "True", "", "", 43}, - {"4.8.8", "Different Policies Test8", "-policy anyPolicy", "True", "", "", 43}, - {"4.8.9", "Different Policies Test9", "-policy anyPolicy", "True", "", "", 43}, - {"4.8.10.1", "All Certificates Same Policies Test10", "-policy ?NIST1", "True", "?NIST1:?NIST2", "?NIST1", 0}, - {"4.8.10.2", "All Certificates Same Policies Test10", "-policy ?NIST2", "True", "?NIST1:?NIST2", "?NIST2", 0}, - {"4.8.10.3", "All Certificates Same Policies Test10", "-policy anyPolicy", "True", "?NIST1:?NIST2", "?NIST1:?NIST2", 0}, - {"4.8.11.1", "All Certificates AnyPolicy Test11", "-policy anyPolicy", "True", "$apolicy", "$apolicy", 0}, - {"4.8.11.2", "All Certificates AnyPolicy Test11", "-policy ?NIST1", "True", "$apolicy", "?NIST1", 0}, - {"4.8.12", "Different Policies Test12", "-policy anyPolicy", "True", "", "", 43}, - {"4.8.13.1", "All Certificates Same Policies Test13", "-policy ?NIST1", "True", "?NIST1:?NIST2:?NIST3", "?NIST1", 0}, - {"4.8.13.2", "All Certificates Same Policies Test13", "-policy ?NIST2", "True", "?NIST1:?NIST2:?NIST3", "?NIST2", 0}, - {"4.8.13.3", "All Certificates Same Policies Test13", "-policy ?NIST3", "True", "?NIST1:?NIST2:?NIST3", "?NIST3", 0}, - {"4.8.14.1", "AnyPolicy Test14", "-policy ?NIST1", "True", "?NIST1", "?NIST1", 0}, - {"4.8.14.2", "AnyPolicy Test14", "-policy ?NIST2", "True", "?NIST1", "", 43}, - {"4.8.15", "User Notice Qualifier Test15", "-policy anyPolicy", "False", "?NIST1", "?NIST1", 0}, - {"4.8.16", "User Notice Qualifier Test16", "-policy anyPolicy", "False", "?NIST1", "?NIST1", 0}, - {"4.8.17", "User Notice Qualifier Test17", "-policy anyPolicy", "False", "?NIST1", "?NIST1", 0}, - {"4.8.18.1", "User Notice Qualifier Test18", "-policy ?NIST1", "True", "?NIST1:?NIST2", "?NIST1", 0}, - {"4.8.18.2", "User Notice Qualifier Test18", "-policy ?NIST2", "True", "?NIST1:?NIST2", "?NIST2", 0}, - {"4.8.19", "User Notice Qualifier Test19", "-policy anyPolicy", "False", "?NIST1", "?NIST1", 0}, - {"4.8.20", "CPS Pointer Qualifier Test20", "-policy anyPolicy -explicit_policy", "True", "?NIST1", "?NIST1", 0}]. -require_explicit_policy_tests() -> - %%{ "4.9", "Require Explicit Policy" }, - [{"4.9.1", "Valid RequireExplicitPolicy Test1", "-policy anyPolicy", "False", "", "", 0}, - {"4.9.2", "Valid RequireExplicitPolicy Test2", "-policy anyPolicy", "False", "", "", 0}, - {"4.9.3", "Invalid RequireExplicitPolicy Test3", "-policy anyPolicy", "True", "", "", 43}, - {"4.9.4", "Valid RequireExplicitPolicy Test4", "-policy anyPolicy", "True", "?NIST1", "?NIST1", 0}, - {"4.9.5", "Invalid RequireExplicitPolicy Test5", "-policy anyPolicy", "True", "", "", 43}, - {"4.9.6", "Valid Self-Issued requireExplicitPolicy Test6", "-policy anyPolicy", "False", "", "", 0}, - {"4.9.7", "Invalid Self-Issued requireExplicitPolicy Test7", "-policy anyPolicy", "True", "", "", 43}, - {"4.9.8", "Invalid Self-Issued requireExplicitPolicy Test8", "-policy anyPolicy", "True", "", "", 43}]. -policy_mappings_tests() -> - %%{ "4.10", "Policy Mappings" }, - [{"4.10.1.1", "Valid Policy Mapping Test1", "-policy ?NIST1", "True", "?NIST1", "?NIST1", 0}, - {"4.10.1.2", "Valid Policy Mapping Test1", "-policy ?NIST2", "True", "?NIST1", "", 43}, - {"4.10.1.3", "Valid Policy Mapping Test1", "-policy anyPolicy -inhibit_map", "True", "", "", 43}, - {"4.10.2.1", "Invalid Policy Mapping Test2", "-policy anyPolicy", "True", "", "", 43}, - {"4.10.2.2", "Invalid Policy Mapping Test2", "-policy anyPolicy -inhibit_map", "True", "", "", 43}, - {"4.10.3.1", "Valid Policy Mapping Test3", "-policy ?NIST1", "True", "?NIST2", "", 43}, - {"4.10.3.2", "Valid Policy Mapping Test3", "-policy ?NIST2", "True", "?NIST2", "?NIST2", 0}, - {"4.10.4", "Invalid Policy Mapping Test4", "-policy anyPolicy", "True", "", "", 43}, - {"4.10.5.1", "Valid Policy Mapping Test5", "-policy ?NIST1", "True", "?NIST1", "?NIST1", 0}, - {"4.10.5.2", "Valid Policy Mapping Test5", "-policy ?NIST6", "True", "?NIST1", "", 43}, - {"4.10.6.1", "Valid Policy Mapping Test6", "-policy ?NIST1", "True", "?NIST1", "?NIST1", 0}, - {"4.10.6.2", "Valid Policy Mapping Test6", "-policy ?NIST6", "True", "?NIST1", "", 43}, - { "4.10.7", "Invalid Mapping From anyPolicy Test7", 42 }, - { "4.10.8", "Invalid Mapping To anyPolicy Test8", 42 }, - {"4.10.9", "Valid Policy Mapping Test9", "-policy anyPolicy", "True", "?NIST1", "?NIST1", 0}, - {"4.10.10", "Invalid Policy Mapping Test10", "-policy anyPolicy", "True", "", "", 43}, - {"4.10.11", "Valid Policy Mapping Test11", "-policy anyPolicy", "True", "?NIST1", "?NIST1", 0}, - - %% TODO: check notice display - {"4.10.12.1", "Valid Policy Mapping Test12", "-policy ?NIST1", "True", "?NIST1:?NIST2", "?NIST1", 0}, - - %% TODO: check notice display - {"4.10.12.2", "Valid Policy Mapping Test12", "-policy ?NIST2", "True", "?NIST1:?NIST2", "?NIST2", 0}, - {"4.10.13", "Valid Policy Mapping Test13", "-policy anyPolicy", "True", "?NIST1", "?NIST1", 0}, - - %% TODO: check notice display - {"4.10.14", "Valid Policy Mapping Test14", "-policy anyPolicy", "True", "?NIST1", "?NIST1", 0}]. - -inhibit_policy_mapping_tests() -> - %%{ "4.11", "Inhibit Policy Mapping" }, - [{"4.11.1", "Invalid inhibitPolicyMapping Test1", "-policy anyPolicy", "True", "", "", 43}, - {"4.11.2", "Valid inhibitPolicyMapping Test2", "-policy anyPolicy", "True", "?NIST1", "?NIST1", 0}, - {"4.11.3", "Invalid inhibitPolicyMapping Test3", "-policy anyPolicy", "True", "", "", 43}, - {"4.11.4", "Valid inhibitPolicyMapping Test4", "-policy anyPolicy", "True", "?NIST2", "?NIST2", 0}, - {"4.11.5", "Invalid inhibitPolicyMapping Test5", "-policy anyPolicy", "True", "", "", 43}, - {"4.11.6", "Invalid inhibitPolicyMapping Test6", "-policy anyPolicy", "True", "", "", 43}, - {"4.11.7", "Valid Self-Issued inhibitPolicyMapping Test7", "-policy anyPolicy", "True", "?NIST1", "?NIST1", 0}, - {"4.11.8", "Invalid Self-Issued inhibitPolicyMapping Test8", "-policy anyPolicy", "True", "", "", 43}, - {"4.11.9", "Invalid Self-Issued inhibitPolicyMapping Test9", "-policy anyPolicy", "True", "", "", 43}, - {"4.11.10", "Invalid Self-Issued inhibitPolicyMapping Test10", "-policy anyPolicy", "True", "", "", 43}, - {"4.11.11", "Invalid Self-Issued inhibitPolicyMapping Test11", "-policy anyPolicy", "True", "", "", 43}]. -inhibit_any_policy_tests() -> - %%{ "4.12", "Inhibit Any Policy" }, - [{"4.12.1", "Invalid inhibitAnyPolicy Test1", "-policy anyPolicy", "True", "", "", 43}, - {"4.12.2", "Valid inhibitAnyPolicy Test2", "-policy anyPolicy", "True", "?NIST1", "?NIST1", 0}, - {"4.12.3.1", "inhibitAnyPolicy Test3", "-policy anyPolicy", "True", "?NIST1", "?NIST1", 0}, - {"4.12.3.2", "inhibitAnyPolicy Test3", "-policy anyPolicy -inhibit_any", "True", "", "", 43}, - {"4.12.4", "Invalid inhibitAnyPolicy Test4", "-policy anyPolicy", "True", "", "", 43}, - {"4.12.5", "Invalid inhibitAnyPolicy Test5", "-policy anyPolicy", "True", "", "", 43}, - {"4.12.6", "Invalid inhibitAnyPolicy Test6", "-policy anyPolicy", "True", "", "", 43}, - {"4.12.7", "Valid Self-Issued inhibitAnyPolicy Test7", ok}, - {"4.12.8", "Invalid Self-Issued inhibitAnyPolicy Test8", 43 }, - {"4.12.9", "Valid Self-Issued inhibitAnyPolicy Test9", ok}, - {"4.12.10", "Invalid Self-Issued inhibitAnyPolicy Test10", 43 }]. +validate_node([], _) -> + true; +validate_node([{Key, Value}| Expected], Node) -> + case maps:get(Key, Node) of + Value -> + validate_node(Expected, Node); + _ -> + throw(false) + end. +validate_qualifiers("4.8.15", [#{qualifier_set := QSet}]) -> + ct:log("QS ~p", [QSet]), + true = [#'UserNotice'{explicitText = + {visibleString, + "q1: This is the user notice from qualifier 1. " + "This certificate is for test purposes only"}}] == QSet; +validate_qualifiers("4.8.16", [#{qualifier_set := QSet}]) -> + ct:log("~p", [QSet]), + true = [#'UserNotice'{explicitText = + {visibleString, + "q1: This is the user notice from qualifier 1. " + "This certificate is for test purposes only"}}] == QSet; +validate_qualifiers("4.8.17", [#{qualifier_set := QSet}]) -> + ct:log("~p", [QSet]), + true = [#'UserNotice'{explicitText = + {visibleString, + "q3: This is the user notice from qualifier 3. " + "This certificate is for test purposes only"}}] == QSet; +validate_qualifiers("4.8.18.1",[#{qualifier_set := QSet}]) -> + ct:log("QS ~p", [QSet]), + true = [#'UserNotice'{explicitText = + {visibleString, + "q4: This is the user notice from qualifier 4 associated " + "with NIST-test-policy-1. " + "This certificate is for test purposes only"}}] == QSet; +validate_qualifiers("4.8.18.2", [#{qualifier_set := QSet}]) -> + ct:log("QS ~p", [QSet]), + true = [#'UserNotice'{explicitText = + {visibleString, + "q5: This is the user notice from qualifier 5 associated" + " with anyPolicy. This user notice should be associated " + "with NIST-test-policy-2" }}] == QSet; +validate_qualifiers("4.8.19", [#{qualifier_set := QSet}]) -> + ct:log("QS ~p", [QSet]), + true = [#'UserNotice'{explicitText = + {visibleString, "q6: Section 4.2.1.5 of RFC 3280 states the maximum size of " + "explicitText is 200 characters, but warns that some non-conforming CAs " + "exceed this limit. Thus RFC 3280 states that certificate users SHOULD " + "gracefully handle explicitText with more than 200 characters. This " + "explicitText is over 200 characters long" + }}] == QSet; +validate_qualifiers("4.8.20", [#{qualifier_set := QSet}]) -> + ct:log("QS ~p", [QSet]), + true = [{uri, "http://csrc.nist.gov/groups/ST/crypto_apps_infra/csor/pki_registration.html#PKITest"}] + == QSet; + +validate_qualifiers("4.10.12.1", [#{qualifier_set := QSet}]) -> + ct:log("QS ~p", [QSet]), + true = [#'UserNotice'{explicitText = + {visibleString, "q7: This is the user notice from qualifier 7" + " associated with NIST-test-policy-3. This user notice should " + "be displayed when NIST-test-policy-1 is in the user-constrained-policy-set" + }}] == QSet; +validate_qualifiers("4.10.12.2", [#{qualifier_set := QSet}]) -> + ct:log("QS ~p", [QSet]), + true = [#'UserNotice'{explicitText = + {visibleString, "q8: This is the user notice from qualifier 8 " + "associated with anyPolicy. This user notice should be displayed" + " when NIST-test-policy-2 is in the user-constrained-policy-set" + }}] == QSet; +validate_qualifiers("4.10.13.1", [#{qualifier_set := QSet1}, #{qualifier_set := QSet2}]) -> + ct:log("QS1 ~p QS2 ~p", [QSet1, QSet2]), + true = [#'UserNotice'{explicitText = + {visibleString, "q9: This is the user notice from qualifier 9 " + "associated with NIST-test-policy-1. This user notice should be" + " displayed for Valid Policy Mapping Test13" + }}] == QSet1, + true = [#'UserNotice'{explicitText = + {visibleString, "q9: This is the user notice from qualifier 9 " + "associated with NIST-test-policy-1. This user notice should be" + " displayed for Valid Policy Mapping Test13" + }}] == QSet2; +validate_qualifiers("4.10.13.2", [#{qualifier_set := QSet}]) -> + ct:log("QS ~p", [QSet]), + true = [#'UserNotice'{explicitText = + {visibleString, "q9: This is the user notice from qualifier 9 " + "associated with NIST-test-policy-1. This user notice should be" + " displayed for Valid Policy Mapping Test13" + }}] == QSet; +validate_qualifiers("4.10.14", [#{qualifier_set := QSet}]) -> + ct:log("QS ~p", [QSet]), + true = [#'UserNotice'{explicitText = + {visibleString, "q10: This is the user notice from qualifier 10 " + "associated with anyPolicy. This user notice should be displayed" + " for Valid Policy Mapping Test14" + }}] == QSet. diff --git a/lib/public_key/test/pubkey_cert_SUITE.erl b/lib/public_key/test/pubkey_cert_SUITE.erl index 7d51d5afda17..43907d5b8a34 100644 --- a/lib/public_key/test/pubkey_cert_SUITE.erl +++ b/lib/public_key/test/pubkey_cert_SUITE.erl @@ -21,10 +21,27 @@ -module(pubkey_cert_SUITE). -include_lib("common_test/include/ct.hrl"). -%% -include_lib("public_key/include/public_key.hrl"). -%% Note: This directive should only be used in test suites. --compile(export_all). +%% CT callbacks +-export([all/0, + groups/0]). + +%% Test cases +-export([time_str_2_gregorian_utc_post2000/0, + time_str_2_gregorian_utc_post2000/1, + time_str_2_gregorian_utc_limit_50_years_before_current_time/0, + time_str_2_gregorian_utc_limit_50_years_before_current_time/1, + time_str_2_gregorian_utc_limit_51_years_before_current_time/0, + time_str_2_gregorian_utc_limit_51_years_before_current_time/1, + time_str_2_gregorian_utc_limit_50_years_from_current_time/0, + time_str_2_gregorian_utc_limit_50_years_from_current_time/1, + time_str_2_gregorian_utc_limit_49_years_from_current_time/0, + time_str_2_gregorian_utc_limit_49_years_from_current_time/1, + time_str_2_gregorian_generaltime_50_years_before_current_time/0, + time_str_2_gregorian_generaltime_50_years_before_current_time/1, + time_str_2_gregorian_generaltime_50_years_from_current_time/0, + time_str_2_gregorian_generaltime_50_years_from_current_time/1 + ]). %%-------------------------------------------------------------------- %% Common Test interface functions ----------------------------------- @@ -37,15 +54,14 @@ groups() -> [{time_str_2_gregorian_sec, [], time_str_two_gregorian()}]. time_str_two_gregorian() -> - [ time_str_2_gregorian_utc_post2000 - , time_str_2_gregorian_utc_limit_50_years_before_current_time - , time_str_2_gregorian_utc_limit_51_years_before_current_time - , time_str_2_gregorian_utc_limit_50_years_from_current_time - , time_str_2_gregorian_utc_limit_49_years_from_current_time - , time_str_2_gregorian_generaltime_50_years_before_current_time - , time_str_2_gregorian_generaltime_50_years_from_current_time + [time_str_2_gregorian_utc_post2000, + time_str_2_gregorian_utc_limit_50_years_before_current_time, + time_str_2_gregorian_utc_limit_51_years_before_current_time, + time_str_2_gregorian_utc_limit_50_years_from_current_time, + time_str_2_gregorian_utc_limit_49_years_from_current_time, + time_str_2_gregorian_generaltime_50_years_before_current_time, + time_str_2_gregorian_generaltime_50_years_from_current_time ]. - %%-------------------------------------------------------------------- %% Test Cases -------------------------------------------------------- %%-------------------------------------------------------------------- @@ -132,8 +148,8 @@ convert_to_datetime_format({Format, Date}, ExpectedYear) -> [Y, M, D] = lists:map(fun (Str) -> erlang:list_to_integer(Str) end, YYMMDD), %% assertions to test that the result is the expected one case Format of - utcTime -> (ExpectedYear rem 100) =:= Y; - generalTime -> ExpectedYear =:= Y + utcTime -> true = (ExpectedYear rem 100) == Y; + generalTime -> true = ExpectedYear == Y end, {{ExpectedYear, M, D}, {0, 0, 0}}.