From c6441edc7a33566e83ce2e223b865019a54f6c47 Mon Sep 17 00:00:00 2001
From: Alexey Shchepin <alexey@process-one.net>
Date: Thu, 17 Nov 2005 05:29:33 +0000
Subject: [PATCH] * src/ejabberd_s2s_in.erl: Support for dNSName certificate
 field and DNS name matching * src/XmppAddr.asn1: Moved here from
 src/tls/XmppAddr.asn1 * src/tls/XmppAddr.asn1: Likewise * src/Makefile.in:
 Updated * src/tls/Makefile.in: Updated

SVN Revision: 435
---
 ChangeLog                   |  9 +++++
 src/Makefile.in             |  7 +++-
 src/{tls => }/XmppAddr.asn1 |  0
 src/ejabberd_s2s_in.erl     | 65 ++++++++++++++++++++++++++++++++-----
 src/tls/Makefile.in         |  6 +---
 5 files changed, 73 insertions(+), 14 deletions(-)
 rename src/{tls => }/XmppAddr.asn1 (100%)

diff --git a/ChangeLog b/ChangeLog
index af12efbf8..aab7596ed 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,3 +1,12 @@
+2005-11-17  Alexey Shchepin  <alexey@sevcom.net>
+
+	* src/ejabberd_s2s_in.erl: Support for dNSName certificate field
+	and DNS name matching
+	* src/XmppAddr.asn1: Moved here from src/tls/XmppAddr.asn1
+	* src/tls/XmppAddr.asn1: Likewise    
+	* src/Makefile.in: Updated
+	* src/tls/Makefile.in: Updated
+
 2005-11-16  Alexey Shchepin  <alexey@sevcom.net>
 
 	* src/odbc/ejabberd_odbc.erl: Support for mnesia-like transaction
diff --git a/src/Makefile.in b/src/Makefile.in
index 67ffe295d..c0dbccafb 100644
--- a/src/Makefile.in
+++ b/src/Makefile.in
@@ -27,9 +27,11 @@ MSGSDIR = $(PRIVDIR)/msgs
 LOGDIR = $(DESTDIR)/var/log/ejabberd
 ETCDIR = $(DESTDIR)/etc/ejabberd
 
+ASN_FLAGS = -bber_bin +der +compact_bit_string +optimize +noobj
+
 all: $(ERLSHLIBS) compile-beam all-recursive
 
-compile-beam:
+compile-beam: XmppAddr.hrl
 	@ERL@ -s make all report -noinput -s erlang halt
 
 
@@ -43,6 +45,9 @@ mostlyclean-recursive maintainer-clean-recursive:
 	done
 
 
+%.hrl: %.asn1
+	erlc $(ASN_FLAGS) $<
+
 $(ERLSHLIBS):	%.so:	%.c
 			gcc -Wall $(CFLAGS) $(LDFLAGS) $(LIBS) \
 			$(subst ../,,$(subst .so,.c,$@)) \
diff --git a/src/tls/XmppAddr.asn1 b/src/XmppAddr.asn1
similarity index 100%
rename from src/tls/XmppAddr.asn1
rename to src/XmppAddr.asn1
diff --git a/src/ejabberd_s2s_in.erl b/src/ejabberd_s2s_in.erl
index ca2a32c56..d8280d1fb 100644
--- a/src/ejabberd_s2s_in.erl
+++ b/src/ejabberd_s2s_in.erl
@@ -14,7 +14,7 @@
 
 %% External exports
 -export([start/2,
-	 start_link/2]).
+	 start_link/2,match_domain/2]).
 
 %% gen_fsm callbacks
 -export([init/1,
@@ -32,7 +32,7 @@
 %-include_lib("ssl/pkix/SSL-PKIX.hrl").
 -include_lib("ssl/pkix/PKIX1Explicit88.hrl").
 -include_lib("ssl/pkix/PKIX1Implicit88.hrl").
--include("tls/XmppAddr.hrl").
+-include("XmppAddr.hrl").
 
 -define(DICT, dict).
 
@@ -239,9 +239,16 @@ wait_for_feature_request({xmlstreamelement, El}, StateData) ->
 					    error ->
 						false;
 					    _ ->
-						lists:member(
-						  AuthDomain,
-						  get_cert_domains(Cert))
+						case idna:domain_utf8_to_ascii(AuthDomain) of
+						    false ->
+							false;
+						    PCAuthDomain ->
+							lists:any(
+							  fun(D) ->
+								  match_domain(
+								    PCAuthDomain, D)
+							  end, get_cert_domains(Cert))
+						end
 					end;
 				    _ ->
 					false
@@ -548,8 +555,7 @@ get_cert_domains(Cert) ->
     lists:flatmap(
       fun(#'AttributeTypeAndValue'{type = ?'id-at-commonName',
 				   value = Val}) ->
-	      case 'PKIX1Explicit88':decode(
-				      'X520CommonName', Val) of
+	      case 'PKIX1Explicit88':decode('X520CommonName', Val) of
 		  {ok, {_, D1}} ->
 		      D = if
 			      is_list(D1) -> D1;
@@ -598,13 +604,27 @@ get_cert_domains(Cert) ->
 						#jid{luser = "",
 						     lserver = LD,
 						     lresource = ""} ->
-						    [LD];
+						    case idna:domain_utf8_to_ascii(LD) of
+							false ->
+							    [];
+							PCLD ->
+							    [PCLD]
+						    end;
 						_ ->
 						    []
 					    end;
 					_ ->
 					    []
 				    end;
+			       ({dNSName, D}) when is_list(D) ->
+				    case jlib:string_to_jid(D) of
+					#jid{luser = "",
+					     lserver = LD,
+					     lresource = ""} ->
+					    [LD];
+					_ ->
+					    []
+				    end;
 			       (_) ->
 				    []
 			    end, SANs);
@@ -615,5 +635,34 @@ get_cert_domains(Cert) ->
 		  []
 	  end, Extensions).
 
+match_domain(Domain, Domain) ->
+    true;
+match_domain(Domain, Pattern) ->
+    DLabels = string:tokens(Domain, "."),
+    PLabels = string:tokens(Pattern, "."),
+    match_labels(DLabels, PLabels).
+
+match_labels([], []) ->
+    true;
+match_labels([], [_ | _]) ->
+    false;
+match_labels([_ | _], []) ->
+    false;
+match_labels([DL | DLabels], [PL | PLabels]) ->
+    case lists:all(fun(C) -> (($a =< C) andalso (C =< $z))
+				 orelse (($0 =< C) andalso (C =< $9))
+				 orelse (C == $-) orelse (C == $*)
+		   end, PL) of
+	true ->
+	    Regexp = regexp:sh_to_awk(PL),
+	    case regexp:match(DL, Regexp) of
+		{match, _, _} ->
+		    match_labels(DLabels, PLabels);
+		_ ->
+		    false
+	    end;
+	false ->
+	    false
+    end.
 
 
diff --git a/src/tls/Makefile.in b/src/tls/Makefile.in
index 936747fe4..e0ebd5d4f 100644
--- a/src/tls/Makefile.in
+++ b/src/tls/Makefile.in
@@ -12,18 +12,14 @@ ERLSHLIBS = ../tls_drv.so
 
 OUTDIR = ..
 EFLAGS = -I .. -pz ..
-ASN_FLAGS = -bber_bin +der +compact_bit_string +optimize +noobj
 OBJS   = \
-	$(OUTDIR)/tls.beam $(OUTDIR)/XmppAddr.beam
+	$(OUTDIR)/tls.beam
 
 all:    $(OBJS) $(ERLSHLIBS)
 
 $(OUTDIR)/%.beam:       %.erl
 	@ERLC@ -W $(EFLAGS) -o $(OUTDIR) $<
 
-%.erl: %.asn1
-	erlc $(ASN_FLAGS) $<
-
 #all:	$(ERLSHLIBS)
 #	erl -s make all report "{outdir, \"..\"}" -noinput -s erlang halt