diff options
Diffstat (limited to 'lib/public_key/src/public_key.erl')
| -rw-r--r-- | lib/public_key/src/public_key.erl | 343 |
1 files changed, 339 insertions, 4 deletions
diff --git a/lib/public_key/src/public_key.erl b/lib/public_key/src/public_key.erl index a79badef24..730f90e745 100644 --- a/lib/public_key/src/public_key.erl +++ b/lib/public_key/src/public_key.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2008-2015. All Rights Reserved. +%% Copyright Ericsson AB 2008-2017. 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. @@ -48,13 +48,17 @@ pkix_issuer_id/2, pkix_normalize_name/1, pkix_path_validation/3, + pkix_verify_hostname/2, pkix_verify_hostname/3, ssh_decode/2, ssh_encode/2, + ssh_hostkey_fingerprint/1, ssh_hostkey_fingerprint/2, ssh_curvename2oid/1, oid2ssh_curvename/1, pkix_crls_validate/3, pkix_dist_point/1, pkix_dist_points/1, + pkix_match_dist_point/2, pkix_crl_verify/2, - pkix_crl_issuer/1 + pkix_crl_issuer/1, + short_name_hash/1 ]). -export_type([public_key/0, private_key/0, pem_entry/0, @@ -89,7 +93,8 @@ -type public_crypt_options() :: [{rsa_pad, rsa_padding()}]. -type rsa_digest_type() :: 'md5' | 'sha'| 'sha224' | 'sha256' | 'sha384' | 'sha512'. -type dss_digest_type() :: 'none' | 'sha'. %% None is for backwards compatibility --type ecdsa_digest_type() :: 'sha'| 'sha224' | 'sha256' | 'sha384' | 'sha512'. +-type ecdsa_digest_type() :: 'sha'| 'sha224' | 'sha256' | 'sha384' | 'sha512'. +-type digest_type() :: rsa_digest_type() | dss_digest_type() | ecdsa_digest_type(). -type crl_reason() :: unspecified | keyCompromise | cACompromise | affiliationChanged | superseded | cessationOfOperation | certificateHold | privilegeWithdrawn | aACompromise. -type oid() :: tuple(). @@ -134,7 +139,8 @@ pem_entry_decode({'SubjectPublicKeyInfo', Der, _}) -> {params, DssParams} = der_decode('DSAParams', Params), {der_decode(KeyType, Key0), DssParams}; 'ECPoint' -> - der_decode(KeyType, Key0) + ECCParams = der_decode('EcpkParameters', Params), + {#'ECPoint'{point = Key0}, ECCParams} end; pem_entry_decode({Asn1Type, Der, not_encrypted}) when is_atom(Asn1Type), is_binary(Der) -> @@ -181,6 +187,13 @@ pem_entry_encode('SubjectPublicKeyInfo', Spki = {'SubjectPublicKeyInfo', {'AlgorithmIdentifier', ?'id-dsa', ParamDer}, KeyDer}, pem_entry_encode('SubjectPublicKeyInfo', Spki); +pem_entry_encode('SubjectPublicKeyInfo', + {#'ECPoint'{point = Key}, ECParam}) when is_binary(Key)-> + Params = der_encode('EcpkParameters',ECParam), + Spki = {'SubjectPublicKeyInfo', + {'AlgorithmIdentifier', ?'id-ecPublicKey', Params}, + Key}, + pem_entry_encode('SubjectPublicKeyInfo', Spki); pem_entry_encode(Asn1Type, Entity) when is_atom(Asn1Type) -> Der = der_encode(Asn1Type, Entity), {Asn1Type, Der, not_encrypted}. @@ -516,6 +529,38 @@ pkix_dist_points(OtpCert) -> [], Value). %%-------------------------------------------------------------------- +-spec pkix_match_dist_point(der_encoded() | #'CertificateList'{}, + #'DistributionPoint'{}) -> boolean(). +%% Description: Check whether the given distribution point matches +%% the "issuing distribution point" of the CRL. +%%-------------------------------------------------------------------- +pkix_match_dist_point(CRL, DistPoint) when is_binary(CRL) -> + pkix_match_dist_point(der_decode('CertificateList', CRL), DistPoint); +pkix_match_dist_point(#'CertificateList'{}, + #'DistributionPoint'{distributionPoint = asn1_NOVALUE}) -> + %% No distribution point name specified - that's considered a match. + true; +pkix_match_dist_point(#'CertificateList'{ + tbsCertList = + #'TBSCertList'{ + crlExtensions = Extensions}}, + #'DistributionPoint'{ + distributionPoint = {fullName, DPs}}) -> + case pubkey_cert:select_extension(?'id-ce-issuingDistributionPoint', Extensions) of + undefined -> + %% If the CRL doesn't have an IDP extension, it + %% automatically qualifies. + true; + #'Extension'{extnValue = IDPValue} -> + %% If the CRL does have an IDP extension, it must match + %% the given DistributionPoint to be considered a match. + IDPEncoded = der_decode('IssuingDistributionPoint', IDPValue), + #'IssuingDistributionPoint'{distributionPoint = {fullName, IDPs}} = + pubkey_cert_records:transform(IDPEncoded, decode), + pubkey_crl:match_one(IDPs, DPs) + end. + +%%-------------------------------------------------------------------- -spec pkix_sign(#'OTPTBSCertificate'{}, rsa_private_key() | dsa_private_key()) -> Der::binary(). %% @@ -719,6 +764,76 @@ pkix_crls_validate(OtpCert, DPAndCRLs0, Options) -> pkix_crls_validate(OtpCert, DPAndCRLs, DPAndCRLs, Options, pubkey_crl:init_revokation_state()). +%-------------------------------------------------------------------- +-spec pkix_verify_hostname(Cert :: #'OTPCertificate'{} | binary(), + ReferenceIDs :: [{uri_id | dns_id | oid(), string()}]) -> boolean(). + +-spec pkix_verify_hostname(Cert :: #'OTPCertificate'{} | binary(), + ReferenceIDs :: [{uri_id | dns_id | oid(), string()}], + Options :: proplists:proplist()) -> boolean(). + +%% Description: Validates a hostname to RFC 6125 +%%-------------------------------------------------------------------- +pkix_verify_hostname(Cert, ReferenceIDs) -> + pkix_verify_hostname(Cert, ReferenceIDs, []). + +pkix_verify_hostname(BinCert, ReferenceIDs, Options) when is_binary(BinCert) -> + pkix_verify_hostname(pkix_decode_cert(BinCert,otp), ReferenceIDs, Options); + +pkix_verify_hostname(Cert = #'OTPCertificate'{tbsCertificate = TbsCert}, ReferenceIDs0, Opts) -> + MatchFun = proplists:get_value(match_fun, Opts, undefined), + FailCB = proplists:get_value(fail_callback, Opts, fun(_Cert) -> false end), + FqdnFun = proplists:get_value(fqdn_fun, Opts, fun verify_hostname_extract_fqdn_default/1), + + ReferenceIDs = [{T,to_string(V)} || {T,V} <- ReferenceIDs0], + PresentedIDs = + try lists:keyfind(?'id-ce-subjectAltName', + #'Extension'.extnID, + TbsCert#'OTPTBSCertificate'.extensions) + of + #'Extension'{extnValue = ExtVals} -> + [{T,to_string(V)} || {T,V} <- ExtVals]; + false -> + [] + catch + _:_ -> [] + end, + %% PresentedIDs example: [{dNSName,"ewstest.ericsson.com"}, {dNSName,"www.ericsson.com"}]} + case PresentedIDs of + [] -> + %% Fallback to CN-ids [rfc6125, ch6] + case TbsCert#'OTPTBSCertificate'.subject of + {rdnSequence,RDNseq} -> + PresentedCNs = + [{cn, to_string(V)} + || ATVs <- RDNseq, % RDNseq is list-of-lists + #'AttributeTypeAndValue'{type = ?'id-at-commonName', + value = {_T,V}} <- ATVs + % _T = kind of string (teletexString etc) + ], + %% Example of PresentedCNs: [{cn,"www.ericsson.se"}] + %% match ReferenceIDs to PresentedCNs + verify_hostname_match_loop(verify_hostname_fqnds(ReferenceIDs, FqdnFun), + PresentedCNs, + MatchFun, FailCB, Cert); + + _ -> + false + end; + _ -> + %% match ReferenceIDs to PresentedIDs + case verify_hostname_match_loop(ReferenceIDs, PresentedIDs, + MatchFun, FailCB, Cert) of + false -> + %% Try to extract DNS-IDs from URIs etc + DNS_ReferenceIDs = + [{dns_is,X} || X <- verify_hostname_fqnds(ReferenceIDs, FqdnFun)], + verify_hostname_match_loop(DNS_ReferenceIDs, PresentedIDs, + MatchFun, FailCB, Cert); + true -> + true + end + end. %%-------------------------------------------------------------------- -spec ssh_decode(binary(), public_key | ssh_file()) -> [{public_key(), Attributes::list()}] @@ -777,6 +892,62 @@ oid2ssh_curvename(?'secp384r1') -> <<"nistp384">>; oid2ssh_curvename(?'secp521r1') -> <<"nistp521">>. %%-------------------------------------------------------------------- +-spec ssh_hostkey_fingerprint(public_key()) -> string(). +-spec ssh_hostkey_fingerprint( digest_type(), public_key()) -> string() + ; ([digest_type()], public_key()) -> [string()] + . + +ssh_hostkey_fingerprint(Key) -> + sshfp_string(md5, public_key:ssh_encode(Key,ssh2_pubkey) ). + +ssh_hostkey_fingerprint(HashAlgs, Key) when is_list(HashAlgs) -> + EncKey = public_key:ssh_encode(Key, ssh2_pubkey), + [sshfp_full_string(HashAlg,EncKey) || HashAlg <- HashAlgs]; +ssh_hostkey_fingerprint(HashAlg, Key) when is_atom(HashAlg) -> + EncKey = public_key:ssh_encode(Key, ssh2_pubkey), + sshfp_full_string(HashAlg, EncKey). + + +sshfp_string(HashAlg, EncodedKey) -> + %% Other HashAlgs than md5 will be printed with + %% other formats than hextstr by + %% ssh-keygen -E <alg> -lf <file> + fp_fmt(sshfp_fmt(HashAlg), crypto:hash(HashAlg, EncodedKey)). + +sshfp_full_string(HashAlg, EncKey) -> + lists:concat([sshfp_alg_name(HashAlg), + [$: | sshfp_string(HashAlg, EncKey)] + ]). + +sshfp_alg_name(sha) -> "SHA1"; +sshfp_alg_name(Alg) -> string:to_upper(atom_to_list(Alg)). + +sshfp_fmt(md5) -> hexstr; +sshfp_fmt(_) -> b64. + +fp_fmt(hexstr, Bin) -> + lists:flatten(string:join([io_lib:format("~2.16.0b",[C1]) || <<C1>> <= Bin], ":")); +fp_fmt(b64, Bin) -> + %% This function clause *seems* to be + %% [C || C<-base64:encode_to_string(Bin), C =/= $=] + %% but I am not sure. Must be checked. + B64Chars = "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/", + BitsInLast = 8*size(Bin) rem 6, + Padding = (6-BitsInLast) rem 6, % Want BitsInLast = [1:5] to map to padding [5:1] and 0 -> 0 + [lists:nth(C+1,B64Chars) || <<C:6>> <= <<Bin/binary,0:Padding>> ]. + +%%-------------------------------------------------------------------- +-spec short_name_hash({rdnSequence, [#'AttributeTypeAndValue'{}]}) -> + string(). + +%% Description: Generates OpenSSL-style hash of a name. +%%-------------------------------------------------------------------- +short_name_hash({rdnSequence, _Attributes} = Name) -> + HashThis = encode_name_for_short_hash(Name), + <<HashValue:32/little, _/binary>> = crypto:hash(sha, HashThis), + string:to_lower(string:right(integer_to_list(HashValue, 16), 8, $0)). + +%%-------------------------------------------------------------------- %%% Internal functions %%-------------------------------------------------------------------- do_verify(DigestOrPlainText, DigestType, Signature, @@ -1039,3 +1210,167 @@ ec_key({PubKey, PrivateKey}, Params) -> parameters = Params, publicKey = PubKey}. +encode_name_for_short_hash({rdnSequence, Attributes0}) -> + Attributes = lists:map(fun normalise_attribute/1, Attributes0), + {Encoded, _} = 'OTP-PUB-KEY':'enc_RDNSequence'(Attributes, []), + Encoded. + +%% Normalise attribute for "short hash". If the attribute value +%% hasn't been decoded yet, decode it so we can normalise it. +normalise_attribute([#'AttributeTypeAndValue'{ + type = _Type, + value = Binary} = ATV]) when is_binary(Binary) -> + case pubkey_cert_records:transform(ATV, decode) of + #'AttributeTypeAndValue'{value = Binary} -> + %% Cannot decode attribute; return original. + [ATV]; + DecodedATV = #'AttributeTypeAndValue'{} -> + %% The new value will either be String or {Encoding,String}. + normalise_attribute([DecodedATV]) + end; +normalise_attribute([#'AttributeTypeAndValue'{ + type = _Type, + value = {Encoding, String}} = ATV]) + when + Encoding =:= utf8String; + Encoding =:= printableString; + Encoding =:= teletexString; + Encoding =:= ia5String -> + %% These string types all give us something that the unicode + %% module understands. + NewValue = normalise_attribute_value(String), + [ATV#'AttributeTypeAndValue'{value = NewValue}]; +normalise_attribute([#'AttributeTypeAndValue'{ + type = _Type, + value = String} = ATV]) when is_list(String) -> + %% A string returned by pubkey_cert_records:transform/2, for + %% certain attributes that commonly have incorrect value types. + NewValue = normalise_attribute_value(String), + [ATV#'AttributeTypeAndValue'{value = NewValue}]. + +normalise_attribute_value(String) -> + Converted = unicode:characters_to_binary(String), + NormalisedString = normalise_string(Converted), + %% We can't use the encoding function for the actual type of the + %% attribute, since some of them don't allow utf8Strings, which is + %% the required encoding when creating the hash. + {NewBinary, _} = 'OTP-PUB-KEY':'enc_X520CommonName'({utf8String, NormalisedString}, []), + NewBinary. + +normalise_string(String) -> + %% Normalise attribute values as required for "short hashes", as + %% implemented by OpenSSL. + + %% Remove ASCII whitespace from beginning and end. + TrimmedLeft = re:replace(String, "^[\s\f\n\r\t\v]+", "", [unicode, global]), + TrimmedRight = re:replace(TrimmedLeft, "[\s\f\n\r\t\v]+$", "", [unicode, global]), + %% Convert multiple whitespace characters to a single space. + Collapsed = re:replace(TrimmedRight, "[\s\f\n\r\t\v]+", "\s", [unicode, global]), + %% Convert ASCII characters to lowercase + Lower = ascii_to_lower(Collapsed), + %% And we're done! + Lower. + +ascii_to_lower(String) -> + %% Can't use string:to_lower/1, because that changes Latin-1 + %% characters as well. + << <<(if $A =< C, C =< $Z -> + C + ($a - $A); + true -> + C + end)>> + || + <<C>> <= iolist_to_binary(String) >>. + +%%%---------------------------------------------------------------- +%%% pkix_verify_hostname help functions +verify_hostname_extract_fqdn_default({dns_id,S}) -> + S; +verify_hostname_extract_fqdn_default({uri_id,URI}) -> + {ok,{https,_,Host,_,_,_}} = http_uri:parse(URI), + Host. + + +verify_hostname_fqnds(L, FqdnFun) -> + [E || E0 <- L, + E <- [try case FqdnFun(E0) of + default -> verify_hostname_extract_fqdn_default(E0); + undefined -> undefined; % will make the "is_list(E)" test fail + Other -> Other + end + catch _:_-> undefined % will make the "is_list(E)" test fail + end], + is_list(E), + E =/= "", + {error,einval} == inet:parse_address(E) + ]. + + +-define(srvName_OID, {1,3,6,1,4,1,434,2,2,1,37,0}). + +verify_hostname_match_default(Ref, Pres) -> + verify_hostname_match_default0(to_lower_ascii(Ref), to_lower_ascii(Pres)). + +verify_hostname_match_default0(FQDN=[_|_], {cn,FQDN}) -> + not lists:member($*, FQDN); +verify_hostname_match_default0(FQDN=[_|_], {cn,Name=[_|_]}) -> + [F1|Fs] = string:tokens(FQDN, "."), + [N1|Ns] = string:tokens(Name, "."), + match_wild(F1,N1) andalso Fs==Ns; +verify_hostname_match_default0({dns_id,R}, {dNSName,P}) -> + R==P; +verify_hostname_match_default0({uri_id,R}, {uniformResourceIdentifier,P}) -> + R==P; +verify_hostname_match_default0({srv_id,R}, {T,P}) when T == srvName ; + T == ?srvName_OID -> + R==P; +verify_hostname_match_default0(_, _) -> + false. + + +match_wild(A, [$*|B]) -> match_wild_suffixes(A, B); +match_wild([C|A], [ C|B]) -> match_wild(A, B); +match_wild([], []) -> true; +match_wild(_, _) -> false. + +%% Match the parts after the only wildcard by comparing them from the end +match_wild_suffixes(A, B) -> match_wild_sfx(lists:reverse(A), lists:reverse(B)). + +match_wild_sfx([$*|_], _) -> false; % Bad name (no wildcards alowed) +match_wild_sfx(_, [$*|_]) -> false; % Bad pattern (no more wildcards alowed) +match_wild_sfx([A|Ar], [A|Br]) -> match_wild_sfx(Ar, Br); +match_wild_sfx(Ar, []) -> not lists:member($*, Ar); % Chk for bad name (= wildcards) +match_wild_sfx(_, _) -> false. + + +verify_hostname_match_loop(Refs0, Pres0, undefined, FailCB, Cert) -> + Pres = lists:map(fun to_lower_ascii/1, Pres0), + Refs = lists:map(fun to_lower_ascii/1, Refs0), + lists:any( + fun(R) -> + lists:any(fun(P) -> + verify_hostname_match_default(R,P) orelse FailCB(Cert) + end, Pres) + end, Refs); +verify_hostname_match_loop(Refs, Pres, MatchFun, FailCB, Cert) -> + lists:any( + fun(R) -> + lists:any(fun(P) -> + (case MatchFun(R,P) of + default -> verify_hostname_match_default(R,P); + Bool -> Bool + end) orelse FailCB(Cert) + end, + Pres) + end, + Refs). + + +to_lower_ascii(S) when is_list(S) -> lists:map(fun to_lower_ascii/1, S); +to_lower_ascii({T,S}) -> {T, to_lower_ascii(S)}; +to_lower_ascii(C) when $A =< C,C =< $Z -> C + ($a-$A); +to_lower_ascii(C) -> C. + +to_string(S) when is_list(S) -> S; +to_string(B) when is_binary(B) -> binary_to_list(B). + |