Tcl Library Source Code

Artifact [5c511cfd90]
Login
EuroTcl/OpenACS 11 - 12 JULY 2024, VIENNA

Artifact 5c511cfd90b7fe9a84e8c6115dbf19df63454ea63eb1a06de96703e8577c221e:

Attachment "ldap.patch" to ticket [60160205fe] added by pda 2018-07-07 09:52:52. (unpublished)
Index: modules/ldap/ldap.man
==================================================================
--- modules/ldap/ldap.man
+++ modules/ldap/ldap.man
@@ -1,7 +1,7 @@
 [comment {-*- tcl -*- doctools manpage}]
-[vset VERSION 1.9.2]
+[vset VERSION 1.10]
 [manpage_begin ldap n [vset VERSION]]
 [keywords {directory access}]
 [keywords internet]
 [keywords ldap]
 [keywords {ldap client}]
@@ -28,11 +28,40 @@
 It works by opening the standard (or secure) LDAP socket on the
 server, and then providing a Tcl API to access the LDAP protocol
 commands.  All server errors are returned as Tcl errors (thrown) which
 must be caught with the Tcl [cmd catch] command.
 
-[include ../common-text/tls-security-notes.inc]
+[section {TLS Security Considerations}]
+
+[para] This package uses the [package TLS] package to handle the
+security for [const LDAPS] connections.
+
+[para] Policy decisions like the set of protocols to support and what
+ciphers to use are not the responsibility of [package TLS], nor of
+this package itself however.
+
+Such decisions are the responsibility of whichever application is
+using the package, and are likely influenced by the set of servers
+the application will talk to as well.
+
+[para] For example, in light of the recent
+[uri http://googleonlinesecurity.blogspot.co.uk/2014/10/this-poodle-bites-exploiting-ssl-30.html \
+{POODLE attack}] discovered by Google many servers will disable support
+for the SSLv3 protocol.
+
+To handle this change the applications using [package TLS] must be
+patched, and not this package, nor [package TLS] itself.
+
+Such a patch may be as simple as generally activating [const tls1]
+support, as shown in the example below.
+
+[example {
+    ldap::tlsoptions -tls1 1 -ssl2 0 -ssl3 0 ;# forcibly activate support for the TLS1 protocol
+
+    ... your own application code ...
+}]
+
 
 [section COMMANDS]
 
 [list_begin definitions]
 
@@ -46,23 +75,130 @@
 [para]
 
 The command blocks until the connection has been established, or
 establishment definitely failed.
 
-[call [cmd ::ldap::secure_connect] [arg host] [opt [arg port]] [opt [arg verify_cert]] [opt [arg sni_servername]]]
+[call [cmd ::ldap::tlsoptions] [cmd reset]]
+
+This command resets TLS options to default values. It returns the
+set of options.
+Using this command is incompatible with the obsolete
+form of [cmd ::ldap::secure_connect] and [cmd ::ldap_starttls].
+
+[call [cmd ::ldap::tlsoptions] [opt "[arg opt1] [arg val1]"] [opt "[arg opt2] [arg val2]"] ...]
+
+This commands adds one or more options to some value, and may be used
+more than one time in order to add options in several steps.  A complete
+description of options may be found in the [package tls] package
+documentation. Valid options and values are:
+
+[list_begin options]
+[opt_def {-cadir} directory  ]
+
+Provide the directory containing the CA certificates.
+No default.
+
+[opt_def {-cafile} file]
+
+Provide the CA file.
+No default.
+
+[opt_def {-cipher} string]
+
+Provide the cipher suites to use.
+No default.
+
+[opt_def {-dhparams} file]
+
+Provide a Diffie-Hellman parameters file.
+No default.
+
+[opt_def {-request} boolean]
+
+Request a certificate from peer during SSL handshake.
+Default: true.
+
+[opt_def {-require} boolean]
+
+Require a valid certificate from peer during SSL handshake. If this is
+set to true then -request must also be set to true.
+Default: false
+
+[opt_def {-servername} host]
+
+Only available if the OpenSSL library the package is linked against
+supports the TLS hostname extension for 'Server Name Indication'
+(SNI). Use to name the logical host we are talking to and expecting a
+certificate for.
+No default.
+
+[opt_def {-ssl2} bool]
+
+Enable use of SSL v2.
+Default: false
+
+[opt_def {-ssl3} bool]
+
+Enable use of SSL v3.
+Default: false
+
+[opt_def {-tls1} bool]
+
+Enable use of TLS v1
+Default: true
+
+[opt_def {-tls1.1} bool]
+
+Enable use of TLS v1.1
+Default: true
+
+[opt_def {-tls1.2} bool]
+
+Enable use of TLS v1.2
+Default: true
+
+[list_end]
+[para]
+
+This command returns the current set of TLS options and values.
+In particular, one may use this command without any arguments to get
+the current set of options.
+
+[para]
+
+Using this command is incompatible with the obsolete
+form of [cmd ::ldap::secure_connect] and [cmd ::ldap_starttls]
+(see below).
+
+[call [cmd ::ldap::secure_connect] [arg host] [opt [arg port]]]
 
 Like [cmd ::ldap::connect], except that the created connection is
 secured by SSL. The port defaults to [const 636].  This command
 depends on the availability of the package [package TLS], which is a
 SSL binding for Tcl. If [package TLS] is not available, then this
 command will fail.
 
 [para]
+
+TLS options are specified with [cmd ::ldap::tlsoptions].
+
+[para]
 
 The command blocks until the connection has been established, or
 establishment definitely failed.
 
+
+[call [cmd ::ldap::secure_connect] [arg host] [opt [arg port]] [opt [arg verify_cert]] [opt [arg sni_servername]]]
+
+Note: this form of the command is deprecated, since TLS options had
+to be specified with a combination of parameters to this command
+([arg verify_cert] and [arg sni_servername]) and arguments to [cmd ::tls::init]
+(from package [package tls]) for example to setup defaults for trusted
+certificates. Prefer the above form (without the [arg verify_cert] and
+[arg sni_servername] parameters) and set TLS options with
+[cmd ::ldap::tlsoptions].
+
 [para]
 
 If [arg verify_cert] is set to 1, the default, this checks the server certificate against
 the known hosts. If [arg sni_servername] is set, the given hostname is used as the 
 hostname for Server Name Indication in the TLS handshake.
@@ -69,26 +205,37 @@
 
 [para]
 
 Use [cmd ::tls::init] to setup defaults for trusted certificates.
 
-[example {
-    tls::init -cadir /etc/ssl/certs/ca-certificates.crt
-}]
-
 [para]
 
 TLS supports different protocol levels. In common use are the versions 1.0, 1.1 and 1.2.
 By default all those versions are offered. If you need to modify the acceptable
-protocols, you can change the ::ldap::tlsProtocols list.
+protocols, you can change the ::ldap::tlsProtocols list (deprecated).
 
 [call [cmd ::ldap::disconnect] [arg handle]]
 
 Closes the ldap connection refered to by the token
 [arg handle]. Returns the empty string as its result.
 
+[call [cmd ::ldap::starttls] [arg handle]]
+
+Start TLS negotiation on the connection denoted by [arg handle],
+with TLS parameters set with [cmd ::ldap::tlsoptions].
+
 [call [cmd ::ldap::starttls] [arg handle] [opt [arg cafile]] [opt [arg certfile]] [opt [arg keyfile]] [opt [arg verify_cert]] [opt [arg sni_servername]]]
+
+Note: this form of the command is deprecated, since TLS options had
+to be specified with a combination of parameters to this command
+([arg cafile], [arg certfile], [arg keyfile], [arg verify_cert]
+and [arg sni_servername]) and arguments to [cmd ::tls::init]
+(from package [package tls]).
+Prefer the above form (without specific TLS arguments)
+and set TLS options with [cmd ::ldap::tlsoptions].
+
+[para]
 
 Start TLS negotiation on the connection denoted by [arg handle].
 
 You need to set at least the [arg cafile] argument to a file with trusted certificates, if [arg verify_cert] is 1, which is the default.
 The [arg sni_servername] can be used to signal a different hostname during the TLS handshake.
@@ -411,10 +558,17 @@
 [call [cmd ::ldap::info] [cmd tls] [arg handle] ]
 
 This command returns 1 if the ldap connection [arg handle] used TLS/SSL for
 connection via [cmd ldap::secure_connect] or completed [cmd ldap::starttls], 0 otherwise.
 
+[call [cmd ::ldap::info] [cmd tlsstatus] [arg handle] ]
+
+This command returns the current security status of an TLS secured
+channel. The result is a list of key-value pairs describing the connected
+peer (see the [package TLS] package documentation for the returned values).
+If the connection is not secured with TLS, an empty list is returned.
+
 [call [cmd ::ldap::info] [cmd saslmechanisms] [arg handle]]
 
 Return the supported SASL mechanisms advertised by the server. Only valid in a
 bound state (anonymous or other).
 
@@ -501,11 +655,11 @@
     ldap::unbind     $handle
     ldap::disconnect $handle
 }]
 [para]
 
-And a another example, a simple query, and processing the
+And another example, a simple query, and processing the
 results.
 
 [para]
 [example {
     package require ldap

Index: modules/ldap/ldap.tcl
==================================================================
--- modules/ldap/ldap.tcl
+++ modules/ldap/ldap.tcl
@@ -42,15 +42,17 @@
 #
 #-----------------------------------------------------------------------------
 
 package require Tcl 8.4
 package require asn 0.7
-package provide ldap 1.9.2
+package provide ldap 1.10
 
 namespace eval ldap {
 
     namespace export    connect secure_connect  \
+			starttls                \
+			tlsoptions              \
                         disconnect              \
                         bind unbind             \
                         bindSASL                \
                         search                  \
                         searchInit           	\
@@ -115,10 +117,53 @@
         68  entryAlreadyExists
         69  objectClassModsProhibited
         80  other
     }
 
+    # TLS options for secure_connect and starttls
+    # (see tcltls documentation, function tls::import)
+    variable validTLSOptions
+    set validTLSOptions {
+	-cadir
+	-cafile
+	-certfile
+	-cipher
+	-command
+	-dhparams
+	-keyfile
+	-model
+	-password
+	-request
+	-require
+	-server
+	-servername
+	-ssl2
+	-ssl3
+	-tls1
+	-tls1.1
+	-tls1.2
+    }
+
+    # Default TLS options for secure_connect and starttls
+    variable defaultTLSOptions
+    array set defaultTLSOptions {
+	-request 1
+	-require 1
+	-ssl2    no
+	-ssl3    no
+	-tls1	 yes
+	-tls1.1	 yes
+	-tls1.2	 yes
+    }
+
+    variable curTLSOptions
+    array set curTLSOptions [array get defaultTLSOptions]
+
+    # are we using the old interface (TLSMode = "compatible") or the
+    # new one (TLSMode = "integrated")
+    variable TLSMode
+    set TLSMode "compatible"
 }
 
 
 #-----------------------------------------------------------------------------
 #    Lookup an numerical ldap result code and return a string version
@@ -248,10 +293,34 @@
    	return -code error \
 		"\"[lindex $args 0]\" is not a ldap connection handle"
    }
    return $conn(tls)
 }
+
+#-----------------------------------------------------------------------------
+#   return the TLS connection status
+#
+#-----------------------------------------------------------------------------
+
+proc ldap::info_tlsstatus {args} {
+   if {[llength $args] != 1} {
+   	return -code error \
+	       "Wrong # of arguments. Usage: ldap::info tlsstatus handle"
+   }
+   CheckHandle [lindex $args 0]
+   upvar #0 [lindex $args 0] conn
+   if {![::info exists conn(tls)]} {
+   	return -code error \
+		"\"[lindex $args 0]\" is not a ldap connection handle"
+   }
+   if {$conn(tls)} then {
+       set r [::tls::status $conn(sock)]
+   } else {
+       set r {}
+   }
+   return $r
+}
 
 proc ldap::info_saslmechanisms {args} {
    if {[llength $args] != 1} {
    	return -code error \
 	       "Wrong # of arguments. Usage: ldap::info saslmechanisms handle"
@@ -388,65 +457,111 @@
     set conn(returnReferences) 0
 
     fileevent $sock readable [list ::ldap::MessageReceiver ::ldap::ldap$sock]
     return ::ldap::ldap$sock
 }
+
+#-----------------------------------------------------------------------------
+#    tlsoptions
+#
+#-----------------------------------------------------------------------------
+proc ldap::tlsoptions {args} {
+    variable curTLSOptions
+    variable validTLSOptions
+    variable defaultTLSOptions
+    variable TLSMode
+
+    if {$args eq "reset"} then {
+	array set curTLSOptions [array get defaultTLSOptions]
+    } else {
+	foreach {opt val} $args {
+	    if {$opt in $validTLSOptions} then {
+		set curTLSOptions($opt) $val
+	    } else {
+		return -code error "invalid TLS option '$opt'"
+	    }
+	}
+    }
+    set TLSMode "integrated"
+    return [array get curTLSOptions]
+}
 
 #-----------------------------------------------------------------------------
 #    secure_connect
 #
 #-----------------------------------------------------------------------------
-proc ldap::secure_connect { host {port 636} {verify_cert 1} {sni_servername ""}} {
+proc ldap::secure_connect { host {port 636} {verify_cert ""} {sni_servername ""}} {
 
     variable tlsProtocols
+    variable curTLSOptions
+    variable TLSMode
 
     package require tls
+
+    #------------------------------------------------------------------
+    #   set options
+    #------------------------------------------------------------------
+
+    if {$TLSMode eq "compatible"} then {
+	#
+	# Compatible with old mode. Build a TLS socket with appropriate
+	# parameters, without changing any other parameter which may
+	# have been set by a previous call to tls::init (as specified
+	# in the ldap.tcl manpage).
+	#
+	if {$verify_cert eq ""} then {
+	    set verify_cert 1
+	}
+	set cmd [list tls::socket -request 1 -require $verify_cert \
+				  -ssl2 no -ssl3 no]
+	if {$sni_servername ne ""} {
+	    lappend cmd -servername $sni_servername
+	}
+
+	# The valid ones depend on the server and openssl version,
+	# tls::ciphers all tells it in the error message, but offers no
+	# nice introspection.
+	foreach {proto active} $tlsProtocols {
+	    lappend cmd $proto $active
+	}
+
+	lappend cmd $host $port
+    } else {
+	#
+	# New, integrated mode. Use only parameters set with
+	# ldap::tlsoptions to build the socket.
+	#
+
+	if {$verify_cert ne "" || $sni_servername ne ""} then {
+	    return -code error "verify_cert/sni_servername: incompatible with the use of tlsoptions"
+	}
+
+	set cmd [list tls::socket {*}[array get curTLSOptions] $host $port]
+    }
 
     #------------------------------------------------------------------
     #   connect via TCP/IP
     #------------------------------------------------------------------
-    set cmd [list tls::socket -request 1 -require $verify_cert \
-                              -ssl2 no -ssl3 no]
-    if {$sni_servername ne ""} {
-	lappend cmd -servername $sni_servername
-    }
-
-    # The valid ones depend on the server and openssl version,
-    # tls::ciphers all tells it in the error message, but offers no
-    # nice introspection.
-    foreach {proto active} $tlsProtocols {
-	lappend cmd $proto $active
-    }
-    lappend cmd $host $port
 
     set sock [eval $cmd]
 
-    fconfigure $sock -blocking no -translation binary -buffering full
-
     #------------------------------------------------------------------
     #   Run the TLS handshake
     #
     #------------------------------------------------------------------
-    set retry 0
-    while {1} {
-        if {$retry > 20} {
-            close $sock
-            return -code error "too long retry to setup SSL connection"
-        }
-        if {[catch { tls::handshake $sock } err]} {
-            if {[string match "*resource temporarily unavailable*" $err]} {
-                after 50
-                incr retry
-            } else {
-                close $sock
-                return -code error $err
-            }
-        } else {
-            break
-        }
+    
+    # run the handshake in synchronous I/O mode
+    fconfigure $sock -blocking yes -translation binary -buffering full
+
+    if {[catch { tls::handshake $sock } err]} {
+	close $sock
+	return -code error $err
     }
 
+    # from now on, run in asynchronous I/O mode
+    fconfigure $sock -blocking no -translation binary -buffering full
+
     #--------------------------------------
     #   initialize connection array
     #--------------------------------------
     upvar ::ldap::ldap$sock conn
     catch { unset conn }
@@ -471,17 +586,65 @@
 #------------------------------------------------------------------------------
 #    starttls -  negotiate tls on an open ldap connection
 #
 #------------------------------------------------------------------------------
 proc ldap::starttls {handle {cafile ""} {certfile ""} {keyfile ""} \
-                     {verify_cert 1} {sni_servername ""}} {
-    CheckHandle $handle
-
-    upvar #0 $handle conn
-
+                     {verify_cert ""} {sni_servername ""}} {
     variable tlsProtocols
-    
+    variable curTLSOptions
+    variable TLSMode
+
+    CheckHandle $handle
+
+    upvar #0 $handle conn
+
+    #------------------------------------------------------------------
+    #   set options
+    #------------------------------------------------------------------
+
+    if {$TLSMode eq "compatible"} then {
+	#
+	# Compatible with old mode. Build a TLS socket with appropriate
+	# parameters, without changing any other parameter which may
+	# have been set by a previous call to tls::init (as specified
+	# in the ldap.tcl manpage).
+	#
+	if {$verify_cert eq ""} then {
+	    set verify_cert 1
+	}
+	set cmd [list tls::import $conn(sock) \
+		     -cafile $cafile -certfile $certfile -keyfile $keyfile \
+		     -request 1 -server 0 -require $verify_cert \
+		     -ssl2 no -ssl3 no ]
+	if {$sni_servername ne ""} {
+	    lappend cmd -servername $sni_servername
+	}
+
+	# The valid ones depend on the server and openssl version,
+	# tls::ciphers all tells it in the error message, but offers no
+	# nice introspection.
+	foreach {proto active} $tlsProtocols {
+	    lappend cmd $proto $active
+	}
+    } else {
+	#
+	# New, integrated mode. Use only parameters set with
+	# ldap::tlsoptions to build the socket.
+	#
+
+	if {$cafile ne "" || $certfile ne "" || $keyfile ne "" ||
+		$verify_cert ne "" || $sni_servername ne ""} then {
+	    return -code error "cafile/certfile/keyfile/verify_cert/sni_servername: incompatible with the use of tlsoptions"
+	}
+
+	set cmd [list tls::import $conn(sock) {*}[array get curTLSOptions]]
+    }
+
+    #------------------------------------------------------------------
+    #   check handle
+    #------------------------------------------------------------------
+
     if {$conn(tls)} {
         return -code error \
             "Cannot StartTLS on connection, TLS already running"
     }
 
@@ -533,21 +696,10 @@
         return -code error \
             "Unexpected LDAP response"
     }
 
     # Initiate the TLS socket setup
-    set cmd [list tls::import $conn(sock) \
-		 -cafile $cafile -certfile $certfile -keyfile $keyfile \
-		 -request 1 -server 0 -require $verify_cert -ssl2 no -ssl3 no ]
-    
-    if {$sni_servername ne ""} {
-	lappend cmd -servername $sni_servername
-    }
-
-    foreach {proto active} $tlsProtocols {
-	lappend cmd $proto $active
-    }
 
     eval $cmd
 
     set retry 0
     while {1} {

Index: modules/ldap/ldapx.man
==================================================================
--- modules/ldap/ldapx.man
+++ modules/ldap/ldapx.man
@@ -1,6 +1,6 @@
-[vset VERSION 1.1]
+[vset VERSION 1.2]
 [comment {-*- tcl -*- doctools manpage}]
 [comment {$Id: ldapx.man,v 1.14 2009/01/29 06:16:19 andreas_kupries Exp $}]
 [manpage_begin ldapx n [vset VERSION]]
 [keywords {directory access}]
 [keywords internet]
@@ -406,11 +406,32 @@
 
 [list_end]
 
 [subsection {Ldap Options}]
 
-A first set of options of the [class ldap] class is used during
+Options are configured on [class ldap] instances using the [cmd configure]
+method.
+
+[para]
+
+The first option is used for TLS parameters:
+
+[list_begin options]
+    [opt_def -tlsoptions [arg list]]
+
+	Specify the set of TLS options to use when connecting to the
+	LDAP server (see the [cmd connect] method). For the list of
+	valid options, see the [package LDAP] package documentation.
+	[para]
+	The default is [const {-request 1 -require 1 -ssl2 no -ssl3 no -tls1 yes -tls1.1 yes -tls1.2 yes}].
+	[para]
+	Example:
+	[para]
+[example {$l configure -tlsoptions {-request yes -require yes}}]
+[list_end]
+
+A set of options of the [class ldap] class is used during
 search operations (methods [method traverse], [method search] and
 [method read], see below).
 
 [list_begin options]
 
@@ -481,10 +502,11 @@
 
 	Default is {{.*} {}}, meaning: all attributes are converted,
 	without exception.
 
 [list_end]
+
 
 [subsection {Ldap Methods}]
 
 [list_begin definitions]
     [call [arg la] [method error] [opt [arg newmsg]]]
@@ -492,19 +514,33 @@
 	This method returns the error message that occurred in the
 	last call to a [class ldap] class method. If the optional
 	argument [arg newmsg] is supplied, it becomes the last
 	error message.
 
-    [call [arg la] [method connect] [arg url] [opt [arg binddn]] [opt [arg bindpw]]]
+    [call [arg la] [method connect] [arg url] [opt [arg binddn]] [opt [arg bindpw]] [opt [arg starttls]]]
 
 	This method connects to the LDAP server using given URL
 	(which can be of the form [uri ldap://host:port] or
 	[uri ldaps://host:port]). If an optional [arg binddn]
 	argument is given together with the [arg bindpw] argument,
 	the [method connect] binds to the LDAP server using the
 	specified DN and password.
 
+	[para]
+
+	If the [arg starttls] argument is given a true value ([const 1],
+	[const yes], etc.) and the URL uses the [uri ldap://] scheme,
+	a TLS negotiation is initiated with the newly created connection,
+	before LDAP binding.
+
+	Default value: [const no].
+
+	[para]
+
+	This method returns 1 if connection was successful, or 0 if an
+	error occurred (use the [cmd error] method to get the message).
+
     [call [arg la] [method disconnect]]
 
 	This method disconnects (and unbinds, if necessary) from
 	the LDAP server.
 
@@ -560,16 +596,17 @@
 
 [example {
     package require ldapx
 
     #
-    # Connects to the LDAP directory
+    # Connects to the LDAP directory using StartTLS
     #
 
     ::ldapx::ldap create l
+    l configure -tlsoptions {-cadir /etc/ssl/certs -request yes -require yes}
     set url "ldap://server.mycomp.com"
-    if {! [l connect $url "cn=admin,o=mycomp" "mypasswd"]} then {
+    if {! [l connect $url "cn=admin,o=mycomp" "mypasswd" yes]} then {
 	puts stderr "error: [l error]"
 	exit 1
     }
 
     #

Index: modules/ldap/ldapx.tcl
==================================================================
--- modules/ldap/ldapx.tcl
+++ modules/ldap/ldapx.tcl
@@ -1,9 +1,9 @@
 #
 # Extended object interface to entries in LDAP directories or LDIF files.
 #
-# (c) 2006-2018 Pierre David ([email protected])
+# (c) 2006-2018 Pierre David ([email protected])
 #
 # $Id: ldapx.tcl,v 1.12 2008/02/07 21:19:39 pdav Exp $
 #
 # History:
 #   2006/08/08 : pda : design
@@ -11,13 +11,13 @@
 
 package require Tcl 8.4
 package require snit		;# tcllib
 package require uri 1.1.5	;# tcllib
 package require base64		;# tcllib
-package require ldap 1.6	;# tcllib, low level code for LDAP directories
+package require ldap 1.10	;# tcllib, low level code for LDAP directories
 
-package provide ldapx 1.1
+package provide ldapx 1.2
 
 ##############################################################################
 # LDAPENTRY object type
 ##############################################################################
 
@@ -849,10 +849,12 @@
     option -derefaliases -default "never"
     option -sizelimit	 -default 0
     option -timelimit	 -default 0
     option -attrsonly	 -default 0
 
+    option -tlsoptions  -default {}
+
     component translator
     delegate option -utf8 to translator
 
     #
     # Channel descriptor
@@ -904,19 +906,23 @@
 	return $lastError
     }
 
     # Connect to the LDAP directory, and binds to it if needed
 
-    method connect {url {binddn {}} {bindpw {}}} {
+    method connect {url {binddn {}} {bindpw {}} {starttls no}} {
 
 	array set comp [::uri::split $url "ldap"]
 
 	if {! [::info exists comp(host)]} then {
 	    $self error "Invalid host in URL '$url'"
 	    return 0
 	}
 
+	# use ::ldap with integrated TLS mode
+	::ldap::tlsoptions reset
+	::ldap::tlsoptions {*}$options(-tlsoptions)
+
 	set scheme $comp(scheme)
 	if {! [::info exists connect_defaults($scheme)]} then {
 	    $self error "Unrecognized URL '$url'"
 	    return 0
 	}
@@ -929,10 +935,16 @@
 	}
 
 	if {[Check $selfns {set channel [$fct $comp(host) $comp(port)]}]} then {
 	    return 0
 	}
+
+	if {$starttls && [string equal $scheme "ldap"]} then {
+	    if {[Check $selfns {::ldap::starttls $channel}]} then {
+		return 0
+	    }
+	}
 
 	if {$binddn eq ""} then {
 	    set bind 0
 	} else {
 	    set bind 1
@@ -940,11 +952,11 @@
 		return 0
 	    }
 	}
 	return 1
     }
-
+    
     # Disconnect from the LDAP directory
 
     method disconnect {} {
 
 	Connected $selfns