Re: Net::LDAPS not checking hostname in certificate: PATCH

[Christopher Odenbach]

Hi,

> > Something should definitely implement that check. I guess it is up
> > to Net::LDAP to do that, because the algorithm to find the
> > hostname/ address
> > might be different for different application protocols using
> > IO::Socket::SSL.
>
> Yes.  The LDAP checks are described in RFC 4513.

OK, attached is my first shot at the problem.

I think that probably the most elegant way to implement the host name 
check would be with the 'SSL_verify_callback' parameter of 
IO::Socket::SSL. But there are two problems:

- the callback is called for every certificate involved, so also for
  signing certificates in the chain, not only for the peer certificate
- the callback only gets few parameters, it does not get the certificate
  subject which includes the host name

So I chose to implement the host check manually at two places: 
connect_ldaps and start_tls.

The attached patch applies to LDAP.pm from the current version 0.34. It 
uses the 'verify' parameter to find out whether to check the host name 
or not.

Now my test program behaves like it should:

[EMAIL PROTECTED]:~/WORK$ ./test_ldap_tls.pl ldap
TLS: Error: host name mismatch in certificate!
[EMAIL PROTECTED]:~/WORK$ ./test_ldap_tls.pl ldap.uni-paderborn.de
OK


Any comments?

Christopher

-- 
======================================================
    Dipl.-Ing. Christopher Odenbach
    Zentrum fuer Informations- und Medientechnologien
    Universitaet Paderborn
    Raum N5.110
    [EMAIL PROTECTED]
    Tel.: +49 5251 60 5315
======================================================

*** LDAP.pm.orig	2007-05-16 12:05:57.000000000 +0200
--- LDAP.pm	2007-05-16 13:11:55.000000000 +0200
***************
*** 178,195 ****
  
    $ldap->{net_ldap_host} = $host;
    $ldap->{net_ldap_port} = $port;
  }
  
  sub _SSL_context_init_args {
    my $arg = shift;
  
-   my $verify = 0;
    my ($clientcert,$clientkey,$passwdcb);
  
!   if (exists $arg->{'verify'}) {
!       my $v = lc $arg->{'verify'};
!       $verify = 0 + (exists $ssl_verify{$v} ? $ssl_verify{$v} : $verify);
!   }
  
    if (exists $arg->{'clientcert'}) {
        $clientcert = $arg->{'clientcert'};
--- 178,222 ----
  
    $ldap->{net_ldap_host} = $host;
    $ldap->{net_ldap_port} = $port;
+ 
+   # check host name
+   unless (verify_hostname ($ldap, $arg)) {
+     $@ = "Host name mismatch in certificate";
+     undef $ldap->{'net_ldap_socket'};
+   }
+ }
+ 
+ sub verify_mode {
+ 	my $arg = shift;
+ 
+ 	my $verify = 0;
+ 	if (exists $arg->{'verify'}) {
+ 		my $v = lc $arg->{'verify'};
+ 		$verify = 0 + (exists $ssl_verify{$v} ? $ssl_verify{$v} : $verify);
+ 	}
+ 	return $verify;
+ }	
+ 
+ sub verify_hostname {
+ 	my $ldap = shift;
+ 	my $arg = shift;
+ 
+ 	# check host name
+ 	my ($cn) = $ldap->socket->peer_certificate ('subject') =~ m/CN=([\w.-]+)/;
+ 	unless ( verify_mode ($arg) == 3 and $cn ne $ldap->{net_ldap_host} ) {
+ 	  	return 1;
+ 	}
+ 
+ 	# otherwise ...
+ 	return 0;
  }
  
  sub _SSL_context_init_args {
    my $arg = shift;
  
    my ($clientcert,$clientkey,$passwdcb);
  
!   my $verify = verify_mode ($arg);
  
    if (exists $arg->{'clientcert'}) {
        $clientcert = $arg->{'clientcert'};
***************
*** 995,1002 ****
    IO::Socket::SSL::context_init( { _SSL_context_init_args($arg) } );
    my $sock_class = ref($sock);
  
!   return $mesg
!     if IO::Socket::SSL::socketToSSL($sock, {_SSL_context_init_args($arg)});
  
    my $err = $@;
  
--- 1022,1036 ----
    IO::Socket::SSL::context_init( { _SSL_context_init_args($arg) } );
    my $sock_class = ref($sock);
  
!   if (IO::Socket::SSL::socketToSSL($sock, {_SSL_context_init_args($arg)})) {
! 	# check host name
! 	if (verify_hostname ($ldap, $arg)) {
! 	  	return $mesg;
! 	} else {
! 		# otherwise raise an error
! 		return _error($ldap, $mesg, LDAP_OPERATIONS_ERROR, "Error: host name mismatch in certificate!");
! 	}
!   }
  
    my $err = $@;
  

pgp442wYlh0Wj.pgp
Description: PGP signature