Check-in [a1c3e96ef5]
EuroTcl/OpenACS 11 - 12 JULY 2024, VIENNA
Overview
Comment:Updated callback info in doc file
Downloads: Tarball | ZIP archive | SQL archive
Timelines: family | ancestors | descendants | both | trunk
Files: files | file ages | folders
SHA3-256: a1c3e96ef5f069afd9e13e2cc5a30ef3f356e5f74c4123af56b9d05a8a0b5a43
User & Date: bohagan on 2024-02-10 22:03:52
Other Links: manifest | tags
Context
2024-02-10
22:55
Added examples to doc check-in: c8af0f28b0 user: bohagan tags: trunk
22:03
Updated callback info in doc file check-in: a1c3e96ef5 user: bohagan tags: trunk
21:04
Updated debug documentation check-in: e8ed4fea49 user: bohagan tags: trunk
Changes

Modified doc/tls.html from [1b5bf51939] to [6ba0c48ef9].

17
18
19
20
21
22
23
24

25
26
27
28
29
30
31
17
18
19
20
21
22
23

24
25
26
27
28
29
30
31







-
+







    <dl>
	<dd><b>tls</b> - binding to <b>OpenSSL</b> library
	for socket and I/O channel communications.</dd>
    </dl>
    </dd>
    <dd><a href="#SYNOPSIS">SYNOPSIS</a> </dd>
    <dd><dl>
	    <dd><b>package require Tcl</b> <em>?8.5?</em></dd>
	    <dd><b>package require Tcl</b> <em>?<b>8.5</b>?</em></dd>
	    <dd><b>package require tls</b></dd>
	    <dt>&nbsp;</dt>
	    <dd><b>tls::init</b> <em>?options?</em> </dd>
	    <dd><b>tls::socket</b> <em>?options? host port</em></dd>
	    <dd><b>tls::socket</b> <em>?-server command? ?options? port</em></dd>
	    <dd><b>tls::handshake</b> <em> channel</em></dd>
	    <dd><b>tls::status</b> <em>?-local? channel</em></dd>
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
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







-
+

















-
-
-
-
-
-
+
+
+
+
+
+
+







<h3><a name="NAME">NAME</a></h3>

<p><strong>tls</strong> - binding to <strong>OpenSSL</strong> library
for socket and I/O channel communications.</p>

<h3><a name="SYNOPSIS">SYNOPSIS</a></h3>

<p><b>package require Tcl 8.5</b><br>
<p><b>package require Tcl</b> <em>?<b>8.5</b>?</em><br>
<b>package require tls</b><br>
<br>
<a href="#tls::init"><b>tls::init</b> <i>?options?</i></a><br>
<a href="#tls::socket"><b>tls::socket</b> <i>?options? host port</i><br>
<a href="#tls::socket"><b>tls::socket</b> <i>?-server command? ?options? port</i></a><br>
<a href="#tls::status"><b>tls::status</b> <i>?-local? channel</i></a><br>
<a href="#tls::connection"><b>tls::connection</b> <i>channel</i></a><br>
<a href="#tls::handshake"><b>tls::handshake</b> <i>channel</i></a><br>
<a href="#tls::import"><b>tls::import</b> <i>channel ?options?</i></a><br>
<a href="#tls::unimport"><b>tls::unimport</b> <i>channel</i></a><br>
<br>
<a href="#tls::protocols"><b>tls::protocols</b></a><br>
<a href="#tls::version"><b>tls::version</b></a><br>
</p>

<h3><a name="DESCRIPTION">DESCRIPTION</a></h3>

<p>This extension provides a generic binding to <a
href="http://www.openssl.org/">OpenSSL</a>, utilizing the
<strong>Tcl_StackChannel</strong>
API for Tcl 8.4 and higher. The sockets behave exactly the same
as channels created using Tcl's built-in <strong>socket</strong>
command with additional options for controlling the SSL session.
<p>This extension provides TCL script access to secure socket communications
using the Transport Layer Security (TLS) protocol. It provides a generic
binding to <a href="http://www.openssl.org/">OpenSSL</a>, utilizing the
<strong>Tcl_StackChannel</strong> API in Tcl 8.4 and higher.
These sockets behave exactly the same as channels created using the built-in
<strong>socket</strong> command, along with additional options for controlling
the SSL session.
</p>

<h3><a name="COMMANDS">COMMANDS</a></h3>

<p>Typically one would use the <strong>tls::socket </strong>command
which provides compatibility with the native Tcl <strong>socket</strong>
command. In such cases <strong>tls::import</strong> should not be
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
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







-
+


+
-
-
+
+
+





-
+



-
-
+
+
+
















-
+




+
-
-
-
-
-
+
+
+
+
+
+




-
+



-
-
-
-
+
+
+
+
+
+
+








	<br>
	<br>

	<dl>

	<dt>
	  <strong>error</strong> <em>channel message</em>
	  <strong>error</strong> <em>channelId message</em>
	</dt>
	<dd>
	  This form of callback is invoked whenever an error occurs during the
	  The <em>message</em> argument contains an error message generated
	  by the OpenSSL function <code>ERR_reason_error_string()</code>.
	  initial connection, handshake, or I/O operations. The <em>message</em>
	  argument can be from the Tcl_ErrnoMsg, OpenSSL function
	  <code>ERR_reason_error_string()</code>, or a custom message.
	</dd>

	<br>

	<dt>
	  <strong>info</strong> <em>channel major minor message type</em>
	  <strong>info</strong> <em>channelId major minor message type</em>
	</dt>
	<dd>
	  This form of callback is invoked by the OpenSSL function
	  <code>SSL_CTX_set_info_callback()</code> during connection setup
	  and use.
	  <code>SSL_set_info_callback()</code> during the initial connection
	  and handshake operations. The <em>type</em> argument is new for
	  TLS 1.8. The arguments are:
	  <br>
	  <ul>
	  <li>Possible values for <em>major</em> are:
	  <code>handshake, alert, connect, accept</code>.</li>
	  <li>Possible values for <em>minor</em> are:
	  <code>start, done, read, write, loop, exit</code>.</li>
	  <li>The <em>message</em> argument is a descriptive string which may
	  be generated either by <code>SSL_state_string_long()</code> or by
	  <code>SSL_alert_desc_string_long()</code>, depending on the context.</li>
	  <li>For alerts, the possible values for <em>type</em> are:
	  <code>warning, fatal, and unknown</code>. For others,
	  <code>info</code> is used.</li>
	  </ul>
	</dd>

	<dt>
	  <strong>message</strong> <em>channel direction version content_type data</em>
	  <strong>message</strong> <em>channelId direction version content_type message</em>
	</dt>
	<dd>
	  This form of callback is invoked by the OpenSSL function
	  <code>SSL_set_msg_callback()</code> whenever a message is sent or
	  received during the initial connection, handshake, or I/O operations.
	  received. It is only available when
	  OpenSSL is complied with the <em>enable-ssl-trace</em> option.
	  Where <em>direction</em> is Sent or Received, <em>version</em> is the
	  protocol version, <em>content_type</em> is the message content type,
	  and <em>data</em> is more info on the message from the <code>SSL_trace</code> API.
	  It is only available when OpenSSL is complied with the
	  <em>enable-ssl-trace</em> option. Arguments are: <em>direction</em> 
	  is <b>Sent</b> or <b>Received</b>, <em>version</em> is the protocol
	  version, <em>content_type</em> is the message content type, and
	  <em>message</em> is more info from the <code>SSL_trace</code> API.
	  This callback is new for TLS 1.8.
	</dd>
	<br>

	<dt>
	  <strong>session</strong> <em>channel session_id ticket lifetime</em>
	  <strong>session</strong> <em>channelId session_id ticket lifetime</em>
	</dt>
	<dd>
	  This form of callback is invoked by the OpenSSL function
	  <code>SSL_CTX_sess_set_new_cb()</code>.
	  Where <em>session_id</em> is the current session identifier,
	  <em>ticket</em> is the session ticket info, and <em>lifetime</em>
	  is the the ticket lifetime in seconds.
	  <code>SSL_CTX_sess_set_new_cb()</code> whenever a new session id is
	  sent by the server during the initial connection and handshake, but
	  can also be received later if the <b>-post_handshake</b> option is
	  used. Arguments are: <em>session_id</em> is the current
	  session identifier, <em>ticket</em> is the session ticket info, and
	  <em>lifetime</em> is the the ticket lifetime in seconds.
	  This callback is new for TLS 1.8.
	</dd>
	<br>
	</dl>
    </dd>

    <br>

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
570
571
572
573




574
575
576
577
578
579

580
581
582

583
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
547
548
549
550
551
552
553
554
555
556
557
558
559
560
561
562
563
564


565
566
567
568
569
570
571
572
573
574
575
576

577
578
579
580
581



582
583
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







+










-
-
+
+
+









-
+




-
-
-
+
+
+
+





-
+



+
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+





-
-
-
-
-
-
-
-
-
-
-
-
-
-
+







-
-
+
+
-
-
+



-
-
+
+
-
-
-
+







	</dt>
	<dd>
	  Invoked when loading or storing a PEM certificate with encryption.
	  Where <em>rwflag</em> is 0 for reading/decryption or 1 for
	  writing/encryption (can prompt user to confirm) and
	  <em>size</em> is the max password length in bytes.
	  The callback should return the password as a string.
	  Both arguments are new for TLS 1.8.
	</dd>
    </dd>

    <br>


    <dt><strong>-validatecommand</strong> <em>callback</em></dt>
    <dd>
	Invokes the specified <em>callback</em> script during handshake in
	order to validate the provided value(s). See below for the possible
	arguments passed to the callback script.
	To reject the value and abort connection, the callback should return 0.
	arguments passed to the callback script. If not specified, OpenSSL
	will accept valid certificates and extensions.
	To reject the value and abort the connection, the callback should return 0.
	To accept the value and continue the connection, it should return 1.
	To reject the value, but continue the connection, it should return 2.

	<br>
	<br>

	<dl>

	<dt>
	  <strong>alpn</strong> <em>channel protocol match</em>
	  <strong>alpn</strong> <em>channelId protocol match</em>
	</dt>
	<dd>
	  For servers, this form of callback is invoked when the client ALPN
	  extension is received. If <em>match</em> is true, <em>protocol</em>
	  is the first <b>-alpn</b> specified protocol common to the both the
	  client and server. If not, the first client specified protocol is
	  used. Called after hello and ALPN callbacks.
	  is the first <b>-alpn</b> option specified protocol common to both
	  the client and server. If not, the first client specified protocol is
	  used. It is called after the hello and ALPN callbacks.
	  This callback is new for TLS 1.8.
	</dd>

	<br>

	<dt>
	  <strong>hello</strong> <em>channel servername</em>
	  <strong>hello</strong> <em>channelId servername</em>
	</dt>
	<dd>
	  For servers, this form of callback is invoked during client hello
	  message processing. The purpose is so the server can select the
	  message processing. It is used to select an appropriate certificate to
	  present, and make other configuration adjustments relevant to that
	  server name and its configuration. Called before SNI and ALPN callbacks.
	  appropriate certificate to present to the client, and to make other
	  configuration adjustments relevant to that server name and its
	  configuration. It is called before the SNI and ALPN callbacks.
	  This callback is new for TLS 1.8.
	</dd>

	<br>

	<dt>
	  <strong>sni</strong> <em>channelId servername</em>
	</dt>
	<dd>
	  For servers, this form of callback is invoked when the Server Name
	  Indication (SNI) extension is received. The <em>servername</em>
	  argument is the client provided server name in the <b>-servername</b>
	  option. The purpose is so when a server supports multiple names, the
	  right certificate can be used. It is called after the hello callback
	  but before the ALPN callback.
	  This callback is new for TLS 1.8.
	</dd>

	<br>

	<dt>
	  <strong>sni</strong> <em>channel servername</em>
	</dt>
	<dd>
	  For servers, this form of callback is invoked when the SNI extension
	  from the client is received. Where <em>servername</em> is the client
	  provided server name from the <b>-servername</b> option. This is
	  used when a server supports multiple names, so the right certificate
	  can be used. Called after hello callback but before ALPN callback.
	</dd>

	<br>

	<dt>
	  <strong>verify</strong> <em>channel depth cert status error</em>
	  <strong>verify</strong> <em>channelId depth cert status error</em>
	</dt>
	<dd>
	  This form of callback is invoked by OpenSSL when a new certificate
	  is received from the peer. It allows the client to check the
	  certificate verification results and choose whether to continue
	  or not. It is called for each certificate in the certificate chain.
	  <ul>
	  <li>The <em>depth</em> argument is an integer representing the
	  current depth on the certificate chain, with
	  <li>The <em>depth</em> argument is the integer depth of the
	  certificate in the certificate chain, where 0 is the peer certificate
	  <code>0</code> as the peer certificate and higher values going
	  up to the Certificate Authority (CA).</li>
	  and higher values going up to the Certificate Authority (CA).</li>
	  <li>The <em>cert</em> argument is a list of key-value pairs similar
	  to those returned by
	  <a href="#tls::status"><strong>tls::status</strong></a>.</li>
	  <li>The <em>status</em> argument is an boolean representing the
	  validity of the current certificate.
	  <li>The <em>status</em> argument is the boolean validity of the
	  current certificate where 0 is invalid and 1 is valid.</li>
	  A value of <code>0</code> means the certificate is deemed invalid.
	  A value of <code>1</code> means the certificate is deemed valid.</li>
	  <li>The <em>error</em> argument supplies the message, if any, generated
	  <li>The <em>error</em> argument is the error message, if any, generated
	  by <code>X509_STORE_CTX_get_error()</code>.</li>
	  </ul>
	</dd>
	<br>
	</dl>
    </dd>
</dl>
676
677
678
679
680
681
682


683



684

685
686
687

688
689
690
691

692










693
694
695
696

697
698
699
700
701
702
703
704

705
706
707
708
709
710
711
689
690
691
692
693
694
695
696
697
698
699
700
701

702
703
704
705
706
707
708
709
710
711

712
713
714
715
716
717
718
719
720
721
722
723
724

725
726
727
728
729
730
731
732

733
734
735
736
737
738
739
740







+
+

+
+
+
-
+



+




+
-
+
+
+
+
+
+
+
+
+
+



-
+







-
+








<p>
<em>
The use of the variable <strong>tls::debug</strong> is not recommended.
It may be removed from future releases.
</em>
</p>
<br>
Example #1: Use HTTP package

<p>This example uses the default Unix platform SSL certificates. For standard
installations, -cadir and -cafile should not be needed. Update -cadir or
replace with -cafile if your platform differs.</p>
Example:

<pre><code>
package require http
package require tls
set url "https://www.tcl.tk/"

http::register https 443 [list ::tls::socket -autoservername true -require true -cadir /etc/ssl/certs \
    -command ::tls::callback -password ::tls::password -validatecommand ::tls::validate_command]

# Check for error
set token [http::geturl "https://www.tcl-lang.org/"]
set token [http::geturl $url]
if {[http::status $token] ne "ok"} {
    puts [format "Error %s" [http::status $token]]
}

# Get web page
set data [http::data $token]
puts [string length $data]

# Cleanup
::http::cleanup $token
</code></pre>

Example #2:
Example #2: Use raw socket
<pre><code>
package require tls

set url "www.tcl-lang.org"
set port 443

set ch [tls::socket -autoservername 1 -servername $url -request 1 -require 1 \
    -alpn {http/1.1 h2} -cadir /etc/ssl/certs -command ::tls::callback \
    -alpn {http/1.1} -cadir /etc/ssl/certs -command ::tls::callback \
    -password ::tls::password -validatecommand ::tls::validate_command $url $port]
chan configure $ch -buffersize 65536
tls::handshake $ch

puts $ch "GET / HTTP/1.1"
flush $ch
after 500
719
720
721
722
723
724
725
726
727



728
729
730
731

732
733
734

735










736
737
738
739
740
741
742
748
749
750
751
752
753
754


755
756
757
758
759
760
761
762
763
764
765
766

767
768
769
770
771
772
773
774
775
776
777
778
779
780
781
782
783







-
-
+
+
+




+



+
-
+
+
+
+
+
+
+
+
+
+







parray conn
parray chan
</code></pre>


<h3><a name="HTTPS EXAMPLE">HTTPS EXAMPLE</a></h3>

<p>This example uses a sample server.pem provided with the TLS release,
courtesy of the <strong>OpenSSL</strong> project.</p>
<p>This example uses the default Unix platform SSL certificates. For standard
installations, -cadir and -cafile should not be needed. Update -cadir or
replace with -cafile if your platform differs.</p>

<pre><code>
package require http
package require tls
set url "https://www.tcl.tk/"

http::register https 443 [list ::tls::socket -autoservername true -require true -cadir /etc/ssl/certs]

# Check for error
set token [http::geturl https://www.tcl.tk/]
set token [http::geturl $url]
if {[http::status $token] ne "ok"} {
    puts [format "Error %s" [http::status $token]]
}

# Get web page
set data [http::data $token]
puts [string length $data]

# Cleanup
::http::cleanup $token
</code></pre>

<h3><a name="SPECIAL CONSIDERATIONS">SPECIAL CONSIDERATIONS</a></h3>

<p>The capabilities of this package can vary enormously based upon how the
linked to OpenSSL library was configured and built. New versions may obsolete

Modified generic/tls.c from [0fd30b2572] to [26178e45e1].

184
185
186
187
188
189
190
191

192
193
194
195
196
197
198
184
185
186
187
188
189
190

191
192
193
194
195
196
197
198







-
+







	if (where & SSL_CB_READ)		minor = "read";
	else if (where & SSL_CB_WRITE)		minor = "write";
	else if (where & SSL_CB_LOOP)		minor = "loop";
	else if (where & SSL_CB_EXIT)		minor = "exit";
	else					minor = "unknown";
    }

    /* Create command to eval */
    /* Create command to eval with fn, chan, major, minor, message, and type args */
    cmdPtr = Tcl_DuplicateObj(statePtr->callback);
    Tcl_ListObjAppendElement(interp, cmdPtr, Tcl_NewStringObj("info", -1));
    Tcl_ListObjAppendElement(interp, cmdPtr,
	    Tcl_NewStringObj(Tcl_GetChannelName(statePtr->self), -1));
    Tcl_ListObjAppendElement(interp, cmdPtr, Tcl_NewStringObj(major, -1));
    Tcl_ListObjAppendElement(interp, cmdPtr, Tcl_NewStringObj(minor, -1));

310
311
312
313
314
315
316
317

318
319
320
321
322
323
324
310
311
312
313
314
315
316

317
318
319
320
321
322
323
324







-
+







	n = BIO_read(bio, buffer, BIO_pending(bio) < 15000 ? BIO_pending(bio) : 14999);
	n = (n<0) ? 0 : n;
	buffer[n] = 0;
	(void)BIO_flush(bio);
	BIO_free(bio);
   }

    /* Create command to eval */
    /* Create command to eval with fn, chan, direction, version, type, and message args */
    cmdPtr = Tcl_DuplicateObj(statePtr->callback);
    Tcl_ListObjAppendElement(interp, cmdPtr, Tcl_NewStringObj("message", -1));
    Tcl_ListObjAppendElement(interp, cmdPtr,
	    Tcl_NewStringObj(Tcl_GetChannelName(statePtr->self), -1));
    Tcl_ListObjAppendElement(interp, cmdPtr, Tcl_NewStringObj(write_p ? "Sent" : "Received", -1));
    Tcl_ListObjAppendElement(interp, cmdPtr, Tcl_NewStringObj(ver, -1));
    Tcl_ListObjAppendElement(interp, cmdPtr, Tcl_NewStringObj(type, -1));
388
389
390
391
392
393
394
395

396
397
398
399
400
401
402
388
389
390
391
392
393
394

395
396
397
398
399
400
401
402







-
+







	}
    } else if (cert == NULL || ssl == NULL) {
	return 0;
    }

    dprintf("VerifyCallback: eval callback");

    /* Create command to eval */
    /* Create command to eval with fn, chan, depth, cert info list, status, and error args */
    cmdPtr = Tcl_DuplicateObj(statePtr->vcmd);
    Tcl_ListObjAppendElement(interp, cmdPtr, Tcl_NewStringObj("verify", -1));
    Tcl_ListObjAppendElement(interp, cmdPtr,
	Tcl_NewStringObj(Tcl_GetChannelName(statePtr->self), -1));
    Tcl_ListObjAppendElement(interp, cmdPtr, Tcl_NewIntObj(depth));
    Tcl_ListObjAppendElement(interp, cmdPtr, Tls_NewX509Obj(interp, cert));
    Tcl_ListObjAppendElement(interp, cmdPtr, Tcl_NewIntObj(ok));
438
439
440
441
442
443
444
445

446
447
448
449
450
451
452
438
439
440
441
442
443
444

445
446
447
448
449
450
451
452







-
+







    statePtr->err = msg;

    dprintf("Called");

    if (statePtr->callback == (Tcl_Obj*)NULL)
	return;

    /* Create command to eval */
    /* Create command to eval with fn, chan, and message args */
    cmdPtr = Tcl_DuplicateObj(statePtr->callback);
    Tcl_ListObjAppendElement(interp, cmdPtr, Tcl_NewStringObj("error", -1));
    Tcl_ListObjAppendElement(interp, cmdPtr,
	    Tcl_NewStringObj(Tcl_GetChannelName(statePtr->self), -1));
    if (msg != NULL) {
	Tcl_ListObjAppendElement(interp, cmdPtr, Tcl_NewStringObj(msg, -1));

528
529
530
531
532
533
534
535

536
537
538
539
540
541
542
528
529
530
531
532
533
534

535
536
537
538
539
540
541
542







-
+







	    strncpy(buf, ret, (size_t) size);
	    return (int)strlen(ret);
	} else {
	    return -1;
	}
    }

    /* Create command to eval */
    /* Create command to eval with fn, rwflag, and size args */
    cmdPtr = Tcl_DuplicateObj(statePtr->password);
    Tcl_ListObjAppendElement(interp, cmdPtr, Tcl_NewStringObj("password", -1));
    Tcl_ListObjAppendElement(interp, cmdPtr, Tcl_NewIntObj(rwflag));
    Tcl_ListObjAppendElement(interp, cmdPtr, Tcl_NewIntObj(size));

    Tcl_Preserve((ClientData) interp);
    Tcl_Preserve((ClientData) statePtr);
607
608
609
610
611
612
613
614

615
616
617
618
619
620
621
607
608
609
610
611
612
613

614
615
616
617
618
619
620
621







-
+








    if (statePtr->callback == (Tcl_Obj*)NULL) {
	return SSL_TLSEXT_ERR_OK;
    } else if (ssl == NULL) {
	return SSL_TLSEXT_ERR_NOACK;
    }

    /* Create command to eval */
    /* Create command to eval with fn, chan, session id, session ticket, and lifetime args */
    cmdPtr = Tcl_DuplicateObj(statePtr->callback);
    Tcl_ListObjAppendElement(interp, cmdPtr, Tcl_NewStringObj("session", -1));
    Tcl_ListObjAppendElement(interp, cmdPtr,
	    Tcl_NewStringObj(Tcl_GetChannelName(statePtr->self), -1));

    /* Session id */
    session_id = SSL_SESSION_get_id(session, &ulen);
684
685
686
687
688
689
690
691

692
693
694
695
696
697
698
684
685
686
687
688
689
690

691
692
693
694
695
696
697
698







-
+







	res = SSL_TLSEXT_ERR_NOACK;
    }

    if (statePtr->vcmd == (Tcl_Obj*)NULL) {
	return res;
    }

    /* Create command to eval */
    /* Create command to eval with fn, chan, depth, cert info list, status, and error args */
    cmdPtr = Tcl_DuplicateObj(statePtr->vcmd);
    Tcl_ListObjAppendElement(interp, cmdPtr, Tcl_NewStringObj("alpn", -1));
    Tcl_ListObjAppendElement(interp, cmdPtr,
	    Tcl_NewStringObj(Tcl_GetChannelName(statePtr->self), -1));
    Tcl_ListObjAppendElement(interp, cmdPtr, Tcl_NewStringObj((const char *) *out, -1));
    Tcl_ListObjAppendElement(interp, cmdPtr, Tcl_NewBooleanObj(res == SSL_TLSEXT_ERR_OK));

797
798
799
800
801
802
803
804

805
806
807
808
809
810
811
797
798
799
800
801
802
803

804
805
806
807
808
809
810
811







-
+







	return SSL_TLSEXT_ERR_NOACK;
    }

    if (statePtr->vcmd == (Tcl_Obj*)NULL) {
	return SSL_TLSEXT_ERR_OK;
    }

    /* Create command to eval */
    /* Create command to eval with fn, chan, and server name args */
    cmdPtr = Tcl_DuplicateObj(statePtr->vcmd);
    Tcl_ListObjAppendElement(interp, cmdPtr, Tcl_NewStringObj("sni", -1));
    Tcl_ListObjAppendElement(interp, cmdPtr,
	    Tcl_NewStringObj(Tcl_GetChannelName(statePtr->self), -1));
    Tcl_ListObjAppendElement(interp, cmdPtr, Tcl_NewStringObj(servername , -1));

    /* Eval callback command */
899
900
901
902
903
904
905
906

907
908
909
910
911
912
913
899
900
901
902
903
904
905

906
907
908
909
910
911
912
913







-
+







    if (len + 2 > remaining) {
	*alert = SSL_R_TLSV1_ALERT_INTERNAL_ERROR;
	return SSL_CLIENT_HELLO_ERROR;
    }
    remaining = len;
    servername = (const char *)p;

    /* Create command to eval */
    /* Create command to eval with fn, chan, and server name args */
    cmdPtr = Tcl_DuplicateObj(statePtr->vcmd);
    Tcl_ListObjAppendElement(interp, cmdPtr, Tcl_NewStringObj("hello", -1));
    Tcl_ListObjAppendElement(interp, cmdPtr,
	    Tcl_NewStringObj(Tcl_GetChannelName(statePtr->self), -1));
    Tcl_ListObjAppendElement(interp, cmdPtr, Tcl_NewStringObj(servername, (Tcl_Size) len));

    /* Eval callback command */