From 66ed8bc404d56cf7277ac34226a8d605740f492e Mon Sep 17 00:00:00 2001
From: Hans Nilsson <hans@erlang.org>
Date: Wed, 16 May 2018 18:53:01 +0200
Subject: public_key: Matchfun for HTTPS

---
 lib/public_key/src/public_key.erl | 38 ++++++++++++++++++++++++++++++--------
 1 file changed, 30 insertions(+), 8 deletions(-)

(limited to 'lib/public_key')

diff --git a/lib/public_key/src/public_key.erl b/lib/public_key/src/public_key.erl
index 1c4acc9e1a..f2b57fd330 100644
--- a/lib/public_key/src/public_key.erl
+++ b/lib/public_key/src/public_key.erl
@@ -49,6 +49,7 @@
 	 pkix_normalize_name/1,
 	 pkix_path_validation/3,
 	 pkix_verify_hostname/2, pkix_verify_hostname/3,
+         pkix_verify_hostname_match_fun/1,
 	 ssh_decode/2, ssh_encode/2,
 	 ssh_hostkey_fingerprint/1, ssh_hostkey_fingerprint/2,
 	 ssh_curvename2oid/1, oid2ssh_curvename/1,
@@ -883,12 +884,23 @@ pkix_crls_validate(OtpCert, DPAndCRLs0, Options) ->
 		       Options, pubkey_crl:init_revokation_state()).
 
 %--------------------------------------------------------------------
--spec pkix_verify_hostname(Cert :: #'OTPCertificate'{} | binary(),
-			   ReferenceIDs :: [{uri_id | dns_id | ip | srv_id | oid(),  string()}]) -> boolean().
+-spec pkix_verify_hostname(#'OTPCertificate'{} | binary(),
+			   referenceIDs()
+                          ) -> boolean().
 
--spec pkix_verify_hostname(Cert :: #'OTPCertificate'{} | binary(),
-			   ReferenceIDs :: [{uri_id | dns_id | ip | srv_id | oid(),  string()}],
-			   Options :: proplists:proplist()) -> boolean().
+-spec pkix_verify_hostname(#'OTPCertificate'{} | binary(),
+			   referenceIDs(),
+			   proplists:proplist()) -> boolean().
+
+-type referenceIDs() :: [referenceID()] .
+-type referenceID() :: {uri_id | dns_id | ip | srv_id | oid(),  string()} .
+
+-spec pkix_verify_hostname_match_fun(high_level_alg()) -> match_fun() .
+
+-type high_level_alg() :: https .
+-type match_fun() ::  fun((ReferenceID::referenceID() | string(),
+                           PresentedID::{atom()|oid(),string()}) -> match_fun_result() ) .
+-type match_fun_result() :: boolean() | default .
 
 %% Description: Validates a hostname to RFC 6125
 %%--------------------------------------------------------------------
@@ -953,6 +965,11 @@ pkix_verify_hostname(Cert = #'OTPCertificate'{tbsCertificate = TbsCert}, Referen
 	    end
     end.
 
+pkix_verify_hostname_match_fun(https) ->
+    fun({dns_id,FQDN=[_|_]}, {dNSName,Name=[_|_]}) -> verify_hostname_match_wildcard(FQDN, Name);
+       (_, _) -> default
+    end.
+
 %%--------------------------------------------------------------------
 -spec ssh_decode(binary(), public_key | ssh_file()) -> [{public_key(), Attributes::list()}]
 	      ; (binary(), ssh2_pubkey) ->  public_key()
@@ -1516,9 +1533,7 @@ verify_hostname_match_default(Ref, 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_wildcard(FQDN, Name);
 verify_hostname_match_default0({dns_id,R}, {dNSName,P}) ->
     R==P;
 verify_hostname_match_default0({uri_id,R}, {uniformResourceIdentifier,P}) ->
@@ -1553,6 +1568,13 @@ verify_hostname_match_default0({srv_id,R}, {?srvName_OID,P}) ->
 verify_hostname_match_default0(_, _) ->
     false.
 
+
+verify_hostname_match_wildcard(FQDN, Name) ->
+    [F1|Fs] = string:tokens(FQDN, "."),
+    [N1|Ns] = string:tokens(Name, "."),
+    match_wild(F1,N1) andalso Fs==Ns.
+
+
 ok({ok,X}) -> X.
 
 l16_to_tup(L) -> list_to_tuple(l16_to_tup(L, [])).
-- 
cgit v1.2.3