TclTLS
Check-in [efd347fa7e]
Login
HomeTimelineDownloadBrowse SourceBranchesTagsTicketsWiki
Overview
Comment:added Matt's patches for the tclhttpd server
Downloads: Tarball | ZIP archive | SQL archive
Timelines: family | ancestors | descendants | both | trunk
Files: files | file ages | folders
SHA1: efd347fa7e35cdfd5b63c99fb31708090a2511dd
User & Date: aborr on 2000-01-20 01:50:55
Other Links: manifest | tags
Context
2000-01-20
01:51
updated copyright notice check-in: 4afdc17574 user: aborr tags: trunk
01:50
added Matt's patches for the tclhttpd server check-in: efd347fa7e user: aborr tags: trunk
01:49
updated copyright notice check-in: 733bc1fa8f user: aborr tags: trunk
Changes
Unified Diff Ignore Whitespace Patch
Modified tls.c from [65b25f6ccd] to [230e3f6e31]. 
1
2
3
4
5
6
7
8
9
10
11

/*
 * Copyright (C) 1997-1999 Matt Newman <matt@novadigm.com>
 *
 * $Header: /home/rkeene/tmp/cvs2fossil/../tcltls/tls/tls/tls.c,v 1.1.1.1 2000/01/19 22:10:58 aborr Exp $
 *
 * TLS (aka SSL) Channel - can be layered on any bi-directional
 * Tcl_Channel (Note: Requires Trf Core Patch)
 *
 * This was built (almost) from scratch based upon observation of
 * OpenSSL 0.9.2B
 *




|








1
2
3
4
5
6
7
8
9
10
11

/*
 * Copyright (C) 1997-1999 Matt Newman <matt@novadigm.com>
 *
 * $Header: /home/rkeene/tmp/cvs2fossil/../tcltls/tls/tls/tls.c,v 1.2 2000/01/20 01:50:55 aborr Exp $
 *
 * TLS (aka SSL) Channel - can be layered on any bi-directional
 * Tcl_Channel (Note: Requires Trf Core Patch)
 *
 * This was built (almost) from scratch based upon observation of
 * OpenSSL 0.9.2B
 *
︙︙
649
650
651
652
653
654
655







656
657
658
659
660
661
662

    if (request) verify |= SSL_VERIFY_CLIENT_ONCE | SSL_VERIFY_PEER;
    if (request && require) verify |= SSL_VERIFY_FAIL_IF_NO_PEER_CERT;
    if (verify == 0) verify = SSL_VERIFY_NONE;

    proto |= (ssl2 ? TLS_PROTO_SSL2 : 0);
    proto |= (ssl3 ? TLS_PROTO_SSL3 : 0);
    proto |= (tls1 ? TLS_PROTO_TLS1 : 0);








    if (model != NULL) {
	int mode;
	/* Get the "model" context */
	chan = Tcl_GetChannel( interp, model, &mode);
	if (chan == (Tcl_Channel)0) {
	    return TCL_ERROR;








>
>
>
>
>
>
>








649
650
651
652
653
654
655
656
657
658
659
660
661
662
663
664
665
666
667
668
669

    if (request) verify |= SSL_VERIFY_CLIENT_ONCE | SSL_VERIFY_PEER;
    if (request && require) verify |= SSL_VERIFY_FAIL_IF_NO_PEER_CERT;
    if (verify == 0) verify = SSL_VERIFY_NONE;

    proto |= (ssl2 ? TLS_PROTO_SSL2 : 0);
    proto |= (ssl3 ? TLS_PROTO_SSL3 : 0);
    proto |= (tls1 ? TLS_PROTO_TLS1 : 0);

    /* reset to NULL if blank string provided */
    if (cert && !*cert) cert = NULL;
    if (key && !*key) key = NULL;
    if (ciphers && !*ciphers) ciphers = NULL;
    if (CAfile && !*CAfile) CAfile = NULL;
    if (CAdir && !*CAdir) CAdir = NULL;

    if (model != NULL) {
	int mode;
	/* Get the "model" context */
	chan = Tcl_GetChannel( interp, model, &mode);
	if (chan == (Tcl_Channel)0) {
	    return TCL_ERROR;
︙︙
Modified tls.tcl from [195c4c676f] to [0307107ef1]. 
1
2
3
4
5
6
7
8
9
10
11

#
# Copyright (C) 1997-1999 Matt Newman <matt@novadigm.com>
#
# $Header: /home/rkeene/tmp/cvs2fossil/../tcltls/tls/tls/tls.tcl,v 1.1.1.1 2000/01/19 22:10:58 aborr Exp $
#
namespace eval tls {
    variable logcmd tclLog
    variable debug 0
 
    # Default flags passed to tls::import
    variable defaults {}


|

|








1
2
3
4
5
6
7
8
9
10
11

#
# Copyright (C) 1997-2000 Matt Newman <matt@novadigm.com>
#
# $Header: /home/rkeene/tmp/cvs2fossil/../tcltls/tls/tls/tls.tcl,v 1.2 2000/01/20 01:51:05 aborr Exp $
#
namespace eval tls {
    variable logcmd tclLog
    variable debug 0
 
    # Default flags passed to tls::import
    variable defaults {}
︙︙
47
48
49
50
51
52
53

54
55
56
57
58
59
60


    for {set idx 0} {$idx < $argc} {incr idx} {
	set arg [lindex $args $idx]
	switch -glob -- $server,$arg {
	0,-myport	-
	*,-myaddr	{lappend sopts $arg [lindex $args [incr idx]]}
	0,-async	{lappend sopts $arg}

	*,-cadir	-
	*,-cafile	-
	*,-certfile	-
	*,-keyfile	-
	*,-command	-
	*,-request	-
	*,-require	-








>








47
48
49
50
51
52
53
54
55
56
57
58
59
60
61


    for {set idx 0} {$idx < $argc} {incr idx} {
	set arg [lindex $args $idx]
	switch -glob -- $server,$arg {
	0,-myport	-
	*,-myaddr	{lappend sopts $arg [lindex $args [incr idx]]}
	0,-async	{lappend sopts $arg}
	*,-cipher	-
	*,-cadir	-
	*,-cafile	-
	*,-certfile	-
	*,-keyfile	-
	*,-command	-
	*,-request	-
	*,-require	-
︙︙
101
102
103
104
105
106
107

108






109
110
111
112
113
114
115

}
proc tls::_accept { iopts callback chan ipaddr port } {
    log 2 [list tls::_accept $iopts $callback $chan $ipaddr $port]

    set chan [eval [list tls::import $chan] $iopts]

    lappend callback $chan $ipaddr $port

    uplevel #0 $callback






}
#
# Sample callback for hooking: -
#
# error
# info
# password








>
|
>
>
>
>
>
>








102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123

}
proc tls::_accept { iopts callback chan ipaddr port } {
    log 2 [list tls::_accept $iopts $callback $chan $ipaddr $port]

    set chan [eval [list tls::import $chan] $iopts]

    lappend callback $chan $ipaddr $port
    if {[catch {
	uplevel #0 $callback
    } err]} {
	log 1 "tls::_accept error: ${::errorInfo}"
	close $chan
    } else {
	log 2 "tls::_accept - called \"$callback\" succeeded"
    }
}
#
# Sample callback for hooking: -
#
# error
# info
# password
︙︙
Powered by Fossil · RSS