mint_shims.erl (8364B)
1 %% Shims for functions introduced in recent Erlang/OTP releases, 2 %% to enable use of Mint on older releases. The code in this module 3 %% was taken directly from the Erlang/OTP project. 4 %% 5 %% File: lib/public_key/src/public_key.erl 6 %% Tag: OTP-20.3.4 7 %% Commit: f2c1d537dc28ffbde5d42aedec70bf4c6574c3ea 8 %% Changes from original file: 9 %% - extracted pkix_verify_hostname/2 and /3, and any private 10 %% functions they depend upon 11 %% - replaced local calls to other public functions in the 12 %% 'public_key' module with fully qualified equivalents 13 %% - replaced local type references with fully qualified equivalents 14 %% 15 %% The original license follows: 16 17 %% %CopyrightBegin% 18 %% 19 %% Copyright Ericsson AB 2013-2017. All Rights Reserved. 20 %% 21 %% Licensed under the Apache License, Version 2.0 (the "License"); 22 %% you may not use this file except in compliance with the License. 23 %% You may obtain a copy of the License at 24 %% 25 %% http://www.apache.org/licenses/LICENSE-2.0 26 %% 27 %% Unless required by applicable law or agreed to in writing, software 28 %% distributed under the License is distributed on an "AS IS" BASIS, 29 %% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. 30 %% See the License for the specific language governing permissions and 31 %% limitations under the License. 32 %% 33 %% %CopyrightEnd% 34 %% 35 -module(mint_shims). 36 37 -include_lib("public_key/include/public_key.hrl"). 38 39 -export([pkix_verify_hostname/2, pkix_verify_hostname/3]). 40 41 %-------------------------------------------------------------------- 42 -spec pkix_verify_hostname(Cert :: #'OTPCertificate'{} | binary(), 43 ReferenceIDs :: [{uri_id | dns_id | ip | srv_id | public_key:oid(), string()}]) -> boolean(). 44 45 -spec pkix_verify_hostname(Cert :: #'OTPCertificate'{} | binary(), 46 ReferenceIDs :: [{uri_id | dns_id | ip | srv_id | public_key:oid(), string()}], 47 Options :: proplists:proplist()) -> boolean(). 48 49 %% Description: Validates a hostname to RFC 6125 50 %%-------------------------------------------------------------------- 51 pkix_verify_hostname(Cert, ReferenceIDs) -> 52 pkix_verify_hostname(Cert, ReferenceIDs, []). 53 54 pkix_verify_hostname(BinCert, ReferenceIDs, Options) when is_binary(BinCert) -> 55 pkix_verify_hostname(public_key:pkix_decode_cert(BinCert,otp), ReferenceIDs, Options); 56 57 pkix_verify_hostname(Cert = #'OTPCertificate'{tbsCertificate = TbsCert}, ReferenceIDs0, Opts) -> 58 MatchFun = proplists:get_value(match_fun, Opts, undefined), 59 FailCB = proplists:get_value(fail_callback, Opts, fun(_Cert) -> false end), 60 FqdnFun = proplists:get_value(fqdn_fun, Opts, fun verify_hostname_extract_fqdn_default/1), 61 62 ReferenceIDs = [{T,to_string(V)} || {T,V} <- ReferenceIDs0], 63 PresentedIDs = 64 try lists:keyfind(?'id-ce-subjectAltName', 65 #'Extension'.extnID, 66 TbsCert#'OTPTBSCertificate'.extensions) 67 of 68 #'Extension'{extnValue = ExtVals} -> 69 [{T,to_string(V)} || {T,V} <- ExtVals]; 70 false -> 71 [] 72 catch 73 _:_ -> [] 74 end, 75 %% PresentedIDs example: [{dNSName,"ewstest.ericsson.com"}, {dNSName,"www.ericsson.com"}]} 76 case PresentedIDs of 77 [] -> 78 %% Fallback to CN-ids [rfc6125, ch6] 79 case TbsCert#'OTPTBSCertificate'.subject of 80 {rdnSequence,RDNseq} -> 81 PresentedCNs = 82 [{cn, to_string(V)} 83 || ATVs <- RDNseq, % RDNseq is list-of-lists 84 #'AttributeTypeAndValue'{type = ?'id-at-commonName', 85 value = {_T,V}} <- ATVs 86 % _T = kind of string (teletexString etc) 87 ], 88 %% Example of PresentedCNs: [{cn,"www.ericsson.se"}] 89 %% match ReferenceIDs to PresentedCNs 90 verify_hostname_match_loop(verify_hostname_fqnds(ReferenceIDs, FqdnFun), 91 PresentedCNs, 92 MatchFun, FailCB, Cert); 93 94 _ -> 95 false 96 end; 97 _ -> 98 %% match ReferenceIDs to PresentedIDs 99 case verify_hostname_match_loop(ReferenceIDs, PresentedIDs, 100 MatchFun, FailCB, Cert) of 101 false -> 102 %% Try to extract DNS-IDs from URIs etc 103 DNS_ReferenceIDs = 104 [{dns_id,X} || X <- verify_hostname_fqnds(ReferenceIDs, FqdnFun)], 105 verify_hostname_match_loop(DNS_ReferenceIDs, PresentedIDs, 106 MatchFun, FailCB, Cert); 107 true -> 108 true 109 end 110 end. 111 112 %%%---------------------------------------------------------------- 113 %%% pkix_verify_hostname help functions 114 verify_hostname_extract_fqdn_default({dns_id,S}) -> 115 S; 116 verify_hostname_extract_fqdn_default({uri_id,URI}) -> 117 % Modified from original to remove dependency on http_uri:parse/1 from inets 118 #{scheme := <<"https">>, host := Host} = 'Elixir.URI':parse(list_to_binary(URI)), 119 binary_to_list(Host). 120 121 122 verify_hostname_fqnds(L, FqdnFun) -> 123 [E || E0 <- L, 124 E <- [try case FqdnFun(E0) of 125 default -> verify_hostname_extract_fqdn_default(E0); 126 undefined -> undefined; % will make the "is_list(E)" test fail 127 Other -> Other 128 end 129 catch _:_-> undefined % will make the "is_list(E)" test fail 130 end], 131 is_list(E), 132 E =/= "", 133 {error,einval} == inet:parse_address(E) 134 ]. 135 136 137 -define(srvName_OID, {1,3,6,1,4,1,434,2,2,1,37,0}). 138 139 verify_hostname_match_default(Ref, Pres) -> 140 verify_hostname_match_default0(to_lower_ascii(Ref), to_lower_ascii(Pres)). 141 142 verify_hostname_match_default0(FQDN=[_|_], {cn,FQDN}) -> 143 not lists:member($*, FQDN); 144 verify_hostname_match_default0(FQDN=[_|_], {cn,Name=[_|_]}) -> 145 [F1|Fs] = string:tokens(FQDN, "."), 146 [N1|Ns] = string:tokens(Name, "."), 147 match_wild(F1,N1) andalso Fs==Ns; 148 verify_hostname_match_default0({dns_id,R}, {dNSName,P}) -> 149 R==P; 150 verify_hostname_match_default0({uri_id,R}, {uniformResourceIdentifier,P}) -> 151 R==P; 152 verify_hostname_match_default0({ip,R}, {iPAddress,P}) when length(P) == 4 -> 153 %% IPv4 154 try 155 list_to_tuple(P) 156 == if is_tuple(R), size(R)==4 -> R; 157 is_list(R) -> ok(inet:parse_ipv4strict_address(R)) 158 end 159 catch 160 _:_ -> 161 false 162 end; 163 164 verify_hostname_match_default0({ip,R}, {iPAddress,P}) when length(P) == 16 -> 165 %% IPv6. The length 16 is due to the certificate specification. 166 try 167 l16_to_tup(P) 168 == if is_tuple(R), size(R)==8 -> R; 169 is_list(R) -> ok(inet:parse_ipv6strict_address(R)) 170 end 171 catch 172 _:_ -> 173 false 174 end; 175 verify_hostname_match_default0({srv_id,R}, {srvName,P}) -> 176 R==P; 177 verify_hostname_match_default0({srv_id,R}, {?srvName_OID,P}) -> 178 R==P; 179 verify_hostname_match_default0(_, _) -> 180 false. 181 182 ok({ok,X}) -> X. 183 184 l16_to_tup(L) -> list_to_tuple(l16_to_tup(L, [])). 185 %% 186 l16_to_tup([A,B|T], Acc) -> l16_to_tup(T, [(A bsl 8) bor B | Acc]); 187 l16_to_tup([], Acc) -> lists:reverse(Acc). 188 189 match_wild(A, [$*|B]) -> match_wild_suffixes(A, B); 190 match_wild([C|A], [ C|B]) -> match_wild(A, B); 191 match_wild([], []) -> true; 192 match_wild(_, _) -> false. 193 194 %% Match the parts after the only wildcard by comparing them from the end 195 match_wild_suffixes(A, B) -> match_wild_sfx(lists:reverse(A), lists:reverse(B)). 196 197 match_wild_sfx([$*|_], _) -> false; % Bad name (no wildcards allowed) 198 match_wild_sfx(_, [$*|_]) -> false; % Bad pattern (no more wildcards allowed) 199 match_wild_sfx([A|Ar], [A|Br]) -> match_wild_sfx(Ar, Br); 200 match_wild_sfx(Ar, []) -> not lists:member($*, Ar); % Chk for bad name (= wildcards) 201 match_wild_sfx(_, _) -> false. 202 203 204 verify_hostname_match_loop(Refs0, Pres0, undefined, FailCB, Cert) -> 205 Pres = lists:map(fun to_lower_ascii/1, Pres0), 206 Refs = lists:map(fun to_lower_ascii/1, Refs0), 207 lists:any( 208 fun(R) -> 209 lists:any(fun(P) -> 210 verify_hostname_match_default(R,P) orelse FailCB(Cert) 211 end, Pres) 212 end, Refs); 213 verify_hostname_match_loop(Refs, Pres, MatchFun, FailCB, Cert) -> 214 lists:any( 215 fun(R) -> 216 lists:any(fun(P) -> 217 (case MatchFun(R,P) of 218 default -> verify_hostname_match_default(R,P); 219 Bool -> Bool 220 end) orelse FailCB(Cert) 221 end, 222 Pres) 223 end, 224 Refs). 225 226 227 to_lower_ascii({ip,_}=X) -> X; 228 to_lower_ascii({iPAddress,_}=X) -> X; 229 to_lower_ascii(S) when is_list(S) -> lists:map(fun to_lower_ascii/1, S); 230 to_lower_ascii({T,S}) -> {T, to_lower_ascii(S)}; 231 to_lower_ascii(C) when $A =< C,C =< $Z -> C + ($a-$A); 232 to_lower_ascii(C) -> C. 233 234 to_string(S) when is_list(S) -> S; 235 to_string(B) when is_binary(B) -> binary_to_list(B); 236 to_string(X) -> X.