Tcl Library Source Code

Check-in [337c7e5654]
Login
Bounty program for improvements to Tcl and certain Tcl packages.
Tcl 2018 Conference, Houston/TX, US, Oct 15-19
Send your abstracts to tclconference@googlegroups.com
or submit via the online form by Aug 20.

Many hyperlinks are disabled.
Use anonymous login to enable hyperlinks.

Overview
Comment:ldap/ldapx <EF> Tkt [60160205fe] Extensions to the TLS handling of ldap(x) enabling the specification of all TLS options instead of the limited set we had before.
Timelines: family | ancestors | ldap-60160205fe-tls
Files: files | file ages | folders
SHA3-256:337c7e56542327788e526b07d8ff1cc4260c7a1b50048fb2a5fbda45252d7227
User & Date: andreask 2018-07-09 21:41:49
References
2018-07-09
21:47 Ticket [60160205fe] Broken support for LDAPS status still Open with 3 other changes artifact: d3318ca8ac user: aku
Context
2018-07-09
21:41
ldap/ldapx <EF> Tkt [60160205fe] Extensions to the TLS handling of ldap(x) enabling the specification of all TLS options instead of the limited set we had before. Leaf check-in: 337c7e5654 user: andreask tags: ldap-60160205fe-tls
21:27
pt::peg::op `drop unrealizable` more conservative, ignore unreachable symbols as realizable. Tests pass. check-in: 4bbe140a79 user: andreask tags: trunk
Changes
Hide Diffs Unified Diffs Ignore Whitespace Patch

Changes to modules/ldap/ldap.man.

1
2
3
4
5
6
7
8
9
..
26
27
28
29
30
31
32
33





























34
35
36
37
38
39
40
..
44
45
46
47
48
49
50




























































































51
52
53
54
55
56
57
58
59




60
61
62
63











64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88





89










90
91
92
93
94
95
96
...
409
410
411
412
413
414
415







416
417
418
419
420
421
422
...
499
500
501
502
503
504
505
506
507
508
509
510
511
512
513
[comment {-*- tcl -*- doctools manpage}]
[vset VERSION 1.9.2]
[manpage_begin ldap n [vset VERSION]]
[keywords {directory access}]
[keywords internet]
[keywords ldap]
[keywords {ldap client}]
[keywords protocol]
[keywords {rfc 2251}]
................................................................................
RFC 4511 ([uri http://www.rfc-editor.org/rfc/rfc4511.txt]).

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 COMMANDS]

[list_begin definitions]

[call [cmd ::ldap::connect] [arg host] [opt [arg port]]]

................................................................................
specified it will default to [const 389].

[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]]]

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]





The command blocks until the connection has been established, or
establishment definitely failed.












[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.

[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.

[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] [opt [arg cafile]] [opt [arg certfile]] [opt [arg keyfile]] [opt [arg verify_cert]] [opt [arg sni_servername]]]











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.

The announced protocols are determined in the same way as [cmd ::ldap::secure_connect].
................................................................................
This command returns all currently existing ldap connection handles.

[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 saslmechanisms] [arg handle]]

Return the supported SASL mechanisms advertised by the server. Only valid in a
bound state (anonymous or other).

[call [cmd ::ldap::info] [cmd control] [arg handle] ]

................................................................................
    ldap::delete $handle $dn

    ldap::unbind     $handle
    ldap::disconnect $handle
}]
[para]

And a another example, a simple query, and processing the
results.

[para]
[example {
    package require ldap
    set handle [ldap::connect ldap.acme.com 389]
    ldap::bind $handle

|







 







|
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>







 







>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
|








>
>
>
>




>
>
>
>
>
>
>
>
>
>
>










<
<
<
<




|






>
>
>
>
>

>
>
>
>
>
>
>
>
>
>







 







>
>
>
>
>
>
>







 







|







1
2
3
4
5
6
7
8
9
..
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
..
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209




210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
...
556
557
558
559
560
561
562
563
564
565
566
567
568
569
570
571
572
573
574
575
576
...
653
654
655
656
657
658
659
660
661
662
663
664
665
666
667
[comment {-*- tcl -*- doctools manpage}]
[vset VERSION 1.10]
[manpage_begin ldap n [vset VERSION]]
[keywords {directory access}]
[keywords internet]
[keywords ldap]
[keywords {ldap client}]
[keywords protocol]
[keywords {rfc 2251}]
................................................................................
RFC 4511 ([uri http://www.rfc-editor.org/rfc/rfc4511.txt]).

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.

[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]

[call [cmd ::ldap::connect] [arg host] [opt [arg port]]]

................................................................................
specified it will default to [const 389].

[para]

The command blocks until the connection has been established, or
establishment definitely failed.

[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 TLS 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.

[para]

Use [cmd ::tls::init] to setup defaults for trusted certificates.





[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 (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.

The announced protocols are determined in the same way as [cmd ::ldap::secure_connect].
................................................................................
This command returns all currently existing ldap connection handles.

[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).

[call [cmd ::ldap::info] [cmd control] [arg handle] ]

................................................................................
    ldap::delete $handle $dn

    ldap::unbind     $handle
    ldap::disconnect $handle
}]
[para]

And another example, a simple query, and processing the
results.

[para]
[example {
    package require ldap
    set handle [ldap::connect ldap.acme.com 389]
    ldap::bind $handle

Changes to modules/ldap/ldap.tcl.

40
41
42
43
44
45
46
47
48
49
50
51


52
53
54
55
56
57
58
...
113
114
115
116
117
118
119











































120
121
122
123
124
125
126
...
246
247
248
249
250
251
252
























253
254
255
256
257
258
259
...
386
387
388
389
390
391
392

























393
394
395
396
397
398
399
400


401
402
403
404
405

406











407
408
409
410
411
412
413
414
415
416
417
418

419
















420
421
422
423
424
425
426
427
428
429

430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445


446
447
448
449
450
451
452
453
454
...
469
470
471
472
473
474
475
476




477
478
479
480

























481

482


















483
484
485
486
487
488
489
...
531
532
533
534
535
536
537
538
539
540
541
542
543
544
545
546
547
548
549
550
551
552
553
554
555
#   written by Jochen Loewer
#   3 June, 1999
#
#-----------------------------------------------------------------------------

package require Tcl 8.4
package require asn 0.7
package provide ldap 1.9.2

namespace eval ldap {

    namespace export    connect secure_connect  \


                        disconnect              \
                        bind unbind             \
                        bindSASL                \
                        search                  \
                        searchInit           	\
		        searchNext	        \
		        searchEnd		\
................................................................................
        66  notAllowedOnNonLeaf
        67  notAllowedOnRDN
        68  entryAlreadyExists
        69  objectClassModsProhibited
        80  other
    }












































}


#-----------------------------------------------------------------------------
#    Lookup an numerical ldap result code and return a string version
#
#-----------------------------------------------------------------------------
................................................................................
   upvar #0 [lindex $args 0] conn
   if {![::info exists conn(tls)]} {
   	return -code error \
		"\"[lindex $args 0]\" is not a ldap connection handle"
   }
   return $conn(tls)
}

























proc ldap::info_saslmechanisms {args} {
   if {[llength $args] != 1} {
   	return -code error \
	       "Wrong # of arguments. Usage: ldap::info saslmechanisms handle"
   }
   return [Saslmechanisms [lindex $args 0]]
................................................................................
    set conn(lastError) ""
    set conn(referenceVar) [namespace current]::searchReferences
    set conn(returnReferences) 0

    fileevent $sock readable [list ::ldap::MessageReceiver ::ldap::ldap$sock]
    return ::ldap::ldap$sock
}


























#-----------------------------------------------------------------------------
#    secure_connect
#
#-----------------------------------------------------------------------------
proc ldap::secure_connect { host {port 636} {verify_cert 1} {sni_servername ""}} {

    variable tlsProtocols



    package require tls

    #------------------------------------------------------------------
    #   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
        }


    }

    #--------------------------------------
    #   initialize connection array
    #--------------------------------------
    upvar ::ldap::ldap$sock conn
    catch { unset conn }

    set conn(host)      $host
................................................................................


#------------------------------------------------------------------------------
#    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


























    variable tlsProtocols

    


















    if {$conn(tls)} {
        return -code error \
            "Cannot StartTLS on connection, TLS already running"
    }

    if {[ldap::waitingForMessages $handle]} {
        return -code error \
................................................................................
    if {$oid ne "1.3.6.1.4.1.1466.20037"} {
        set conn(tlsHandshakeInProgress) 0
        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} {
        if {$retry > 20} {
            close $sock







|




>
>







 







>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>







 







>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>







 







>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>





|


>
>




<
>

>
>
>
>
>
>
>
>
>
>
>
|
|
|
|
|

|
|
|
|
|
|
>
|
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>



<
<




<
>
|
|
<
<
|
|
<
<
<
<
|
|
|
<
<
|
>
>
|
<







 







|
>
>
>
>




>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
|
>
|
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>







 







<
<
<
<
<
<
<
<
<
<
<







40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
...
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
...
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
...
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500

501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
516
517
518
519
520
521
522
523
524
525
526
527
528
529
530
531
532
533
534
535
536
537
538
539
540
541
542
543
544
545
546


547
548
549
550

551
552
553


554
555




556
557
558


559
560
561
562

563
564
565
566
567
568
569
...
584
585
586
587
588
589
590
591
592
593
594
595
596
597
598
599
600
601
602
603
604
605
606
607
608
609
610
611
612
613
614
615
616
617
618
619
620
621
622
623
624
625
626
627
628
629
630
631
632
633
634
635
636
637
638
639
640
641
642
643
644
645
646
647
648
649
650
651
652
...
694
695
696
697
698
699
700











701
702
703
704
705
706
707
#   written by Jochen Loewer
#   3 June, 1999
#
#-----------------------------------------------------------------------------

package require Tcl 8.4
package require asn 0.7
package provide ldap 1.10

namespace eval ldap {

    namespace export    connect secure_connect  \
			starttls                \
			tlsoptions              \
                        disconnect              \
                        bind unbind             \
                        bindSASL                \
                        search                  \
                        searchInit           	\
		        searchNext	        \
		        searchEnd		\
................................................................................
        66  notAllowedOnNonLeaf
        67  notAllowedOnRDN
        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
#
#-----------------------------------------------------------------------------
................................................................................
   upvar #0 [lindex $args 0] conn
   if {![::info exists conn(tls)]} {
   	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"
   }
   return [Saslmechanisms [lindex $args 0]]
................................................................................
    set conn(lastError) ""
    set conn(referenceVar) [namespace current]::searchReferences
    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 ""} {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 sock [eval $cmd]



    #------------------------------------------------------------------
    #   Run the TLS handshake
    #
    #------------------------------------------------------------------

    
    # 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 }

    set conn(host)      $host
................................................................................


#------------------------------------------------------------------------------
#    starttls -  negotiate tls on an open ldap connection
#
#------------------------------------------------------------------------------
proc ldap::starttls {handle {cafile ""} {certfile ""} {keyfile ""} \
                     {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"
    }

    if {[ldap::waitingForMessages $handle]} {
        return -code error \
................................................................................
    if {$oid ne "1.3.6.1.4.1.1466.20037"} {
        set conn(tlsHandshakeInProgress) 0
        return -code error \
            "Unexpected LDAP response"
    }

    # Initiate the TLS socket setup












    eval $cmd

    set retry 0
    while {1} {
        if {$retry > 20} {
            close $sock

Changes to modules/ldap/ldapx.man.

1
2
3
4
5
6
7
8
...
404
405
406
407
408
409
410





















411
412
413
414
415
416
417
418
...
479
480
481
482
483
484
485

486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505














506
507
508
509
510
511
512
...
558
559
560
561
562
563
564
565
566
567
568

569
570
571
572
573
574
575
576
577
[vset VERSION 1.1]
[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]
[keywords ldap]
[keywords {ldap client}]
................................................................................
	modified in nearly all methods). The [method error] method
	may be used to fetch this message.

[list_end]

[subsection {Ldap Options}]






















A first 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]

    [opt_def -scope [const base]|[const one]|[const sub]]

................................................................................

	[para]

	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]]]

	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]]]

	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.















    [call [arg la] [method disconnect]]

	This method disconnects (and unbinds, if necessary) from
	the LDAP server.

    [call [arg la] [method traverse] [arg base] [arg filter] [arg attrs] [arg entry] [arg body]]

................................................................................

[subsection {Ldap Example}]

[example {
    package require ldapx

    #
    # Connects to the LDAP directory
    #

    ::ldapx::ldap create l

    set url "ldap://server.mycomp.com"
    if {! [l connect $url "cn=admin,o=mycomp" "mypasswd"]} then {
	puts stderr "error: [l error]"
	exit 1
    }

    #
    # Search all entries matching some criterion
    #
|







 







>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
|







 







>











|








>
>
>
>
>
>
>
>
>
>
>
>
>
>







 







|



>

|







1
2
3
4
5
6
7
8
...
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
...
500
501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
516
517
518
519
520
521
522
523
524
525
526
527
528
529
530
531
532
533
534
535
536
537
538
539
540
541
542
543
544
545
546
547
548
...
594
595
596
597
598
599
600
601
602
603
604
605
606
607
608
609
610
611
612
613
614
[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]
[keywords ldap]
[keywords {ldap client}]
................................................................................
	modified in nearly all methods). The [method error] method
	may be used to fetch this message.

[list_end]

[subsection {Ldap Options}]

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]

    [opt_def -scope [const base]|[const one]|[const sub]]

................................................................................

	[para]

	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]]]

	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]] [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.

    [call [arg la] [method traverse] [arg base] [arg filter] [arg attrs] [arg entry] [arg body]]

................................................................................

[subsection {Ldap Example}]

[example {
    package require ldapx

    #
    # 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" yes]} then {
	puts stderr "error: [l error]"
	exit 1
    }

    #
    # Search all entries matching some criterion
    #

Changes to modules/ldap/ldapx.tcl.

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
...
847
848
849
850
851
852
853


854
855
856
857
858
859
860
...
902
903
904
905
906
907
908
909
910
911
912
913
914
915
916
917




918
919
920
921
922
923
924
...
927
928
929
930
931
932
933






934
935
936
937
938
939
940
941
942
943
944
945
946
947
948
949
950
951
952
#
# Extended object interface to entries in LDAP directories or LDIF files.
#
# (c) 2006-2018 Pierre David (pdav@users.sourceforge.net)
#
# $Id: ldapx.tcl,v 1.12 2008/02/07 21:19:39 pdav Exp $
#
# History:
#   2006/08/08 : pda : design
#

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 provide ldapx 1.1

##############################################################################
# LDAPENTRY object type
##############################################################################

snit::type ::ldapx::entry {
    #########################################################################
................................................................................

    option -scope        -default "sub"
    option -derefaliases -default "never"
    option -sizelimit	 -default 0
    option -timelimit	 -default 0
    option -attrsonly	 -default 0



    component translator
    delegate option -utf8 to translator

    #
    # Channel descriptor
    #

................................................................................
	    set lastError $le
	}
	return $lastError
    }

    # Connect to the LDAP directory, and binds to it if needed

    method connect {url {binddn {}} {bindpw {}}} {

	array set comp [::uri::split $url "ldap"]

	if {! [::info exists comp(host)]} then {
	    $self error "Invalid host in URL '$url'"
	    return 0
	}





	set scheme $comp(scheme)
	if {! [::info exists connect_defaults($scheme)]} then {
	    $self error "Unrecognized URL '$url'"
	    return 0
	}

	set defport [lindex $connect_defaults($scheme) 0]
................................................................................
	if {[string equal $comp(port) ""]} then {
	    set comp(port) $defport
	}

	if {[Check $selfns {set channel [$fct $comp(host) $comp(port)]}]} then {
	    return 0
	}







	if {$binddn eq ""} then {
	    set bind 0
	} else {
	    set bind 1
	    if {[Check $selfns {::ldap::bind $channel $binddn $bindpw}]} then {
		return 0
	    }
	}
	return 1
    }

    # Disconnect from the LDAP directory

    method disconnect {} {

	Connected $selfns

	if {$bind} {



|











|

|







 







>
>







 







|








>
>
>
>







 







>
>
>
>
>
>











|







1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
...
847
848
849
850
851
852
853
854
855
856
857
858
859
860
861
862
...
904
905
906
907
908
909
910
911
912
913
914
915
916
917
918
919
920
921
922
923
924
925
926
927
928
929
930
...
933
934
935
936
937
938
939
940
941
942
943
944
945
946
947
948
949
950
951
952
953
954
955
956
957
958
959
960
961
962
963
964
#
# Extended object interface to entries in LDAP directories or LDIF files.
#
# (c) 2006-2018 Pierre David (pdagog@gmail.com)
#
# $Id: ldapx.tcl,v 1.12 2008/02/07 21:19:39 pdav Exp $
#
# History:
#   2006/08/08 : pda : design
#

package require Tcl 8.4
package require snit		;# tcllib
package require uri 1.1.5	;# tcllib
package require base64		;# tcllib
package require ldap 1.10	;# tcllib, low level code for LDAP directories

package provide ldapx 1.2

##############################################################################
# LDAPENTRY object type
##############################################################################

snit::type ::ldapx::entry {
    #########################################################################
................................................................................

    option -scope        -default "sub"
    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
    #

................................................................................
	    set lastError $le
	}
	return $lastError
    }

    # Connect to the LDAP directory, and binds to it if needed

    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
	}

	set defport [lindex $connect_defaults($scheme) 0]
................................................................................
	if {[string equal $comp(port) ""]} then {
	    set comp(port) $defport
	}

	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
	    if {[Check $selfns {::ldap::bind $channel $binddn $bindpw}]} then {
		return 0
	    }
	}
	return 1
    }
    
    # Disconnect from the LDAP directory

    method disconnect {} {

	Connected $selfns

	if {$bind} {