Check-in [5ed815df85]

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

Overview
Comment: * tests/tlsIO.test: updated comments, fixed a pcCrash case that was due to debug assertion in Windows SSL.
Downloads: Tarball | ZIP archive | SQL archive
Timelines: family | ancestors | merge-1-3-io-rewrite-07-26-00 | tls-1-3-io-rewrite
Files: files | file ages | folders
SHA1:5ed815df857b383a3ff726e15e6e739f2b4954b6
User & Date: hobbs 2000-07-26 23:11:46
Context
2000-07-26
23:11
* tests/tlsIO.test: updated comments, fixed a pcCrash case that was due to debug assertion in Windows SSL. Closed-Leaf check-in: 5ed815df85 user: hobbs tags: merge-1-3-io-rewrite-07-26-00, tls-1-3-io-rewrite
22:15
* tls.c (ImportObjCmd): removed unnecessary use of 'bio' arg. (Tls_Init): check return value of SSL_library_init. Also lots of whitespace cleanup (more like Tcl Eng style guide), but not all code was cleaned up. * tlsBIO.c: minor whitespace cleanup * tlsIO.c: minor whitespace cleanup. (TlsInputProc, TlsOutputProc): Added ERR_clear_error before calls to BIO_read or BIO_write, because we could otherwise end up pulling an error off the stack that didn't belong to us. Also cleanup up excessive use of gotos. check-in: e64e21d80e user: hobbs tags: tls-1-3-io-rewrite
Changes

Changes to ChangeLog.

1



2
3
4
5
6
7
8
2000-07-26  Jeff Hobbs  <hobbs@scriptics.com>




	* tls.c (ImportObjCmd): removed unnecessary use of 'bio' arg.
	(Tls_Init): check return value of SSL_library_init.  Also lots of
	whitespace cleanup (more like Tcl Eng style guide), but not all
	code was cleaned up.

	* tlsBIO.c: minor whitespace cleanup

>
>
>







1
2
3
4
5
6
7
8
9
10
11
2000-07-26  Jeff Hobbs  <hobbs@scriptics.com>

	* tests/tlsIO.test: updated comments, fixed a pcCrash case that
	was due to debug assertion in Windows SSL.

	* tls.c (ImportObjCmd): removed unnecessary use of 'bio' arg.
	(Tls_Init): check return value of SSL_library_init.  Also lots of
	whitespace cleanup (more like Tcl Eng style guide), but not all
	code was cleaned up.

	* tlsBIO.c: minor whitespace cleanup

Changes to tests/tlsIO.test.

6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
...
669
670
671
672
673
674
675
676



677
678
679
680
681
682
683
...
793
794
795
796
797
798
799

800
801
802
803
804
805
806
...
897
898
899
900
901
902
903
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
931
932
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
...
971
972
973
974
975
976
977
978
979
980
981
982
983
984
985
986
....
1841
1842
1843
1844
1845
1846
1847
1848

1849
1850
1851
1852
1853
1854
1855
#
# Copyright (c) 1994-1996 Sun Microsystems, Inc.
# Copyright (c) 1998-2000 Ajuba Solutions. 
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
#
# RCS: @(#) $Id: tlsIO.test,v 1.14.2.4 2000/07/21 05:32:57 hobbs Exp $

# Running socket tests with a remote server:
# ------------------------------------------
# 
# Some tests in socket.test depend on the existence of a remote server to
# which they connect. The remote server must be an instance of tcltest and it
# must run the script found in the file "remote.tcl" in this directory. You
................................................................................
    fconfigure $sock -blocking 1
    close $s2
    close $s
    close $sock
    set result
} {a:one b: c:two}

test tlsIO-2.12 {tcp connection; no certificates specified} {socket stdio pcCrash} {



    removeFile script
    set f [open script w]
    puts $f {
    	package require tls
	set timer [after 2000 "set x timed_out"]
	set f [tls::socket -server accept 8828]
	proc accept {file addr port} {
................................................................................
    close $s3
    lappend x [gets $f]
    close $f
    set x
} {ready done}

test tlsIO-4.1 {server with several clients} {socket stdio} {

    removeFile script
    set f [open script w]
    puts $f {
    	package require tls
	gets stdin
    }
    puts $f "set s \[tls::socket -certfile $clientCert -cafile $caCert -keyfile $clientKey 127.0.0.1 8828 \]"
................................................................................
    if {![catch {tls::socket -server dodo 21} msg]} {
	set x {htons problem, should be disallowed, are you running as SU?}
	close $msg
    }
    set x
} {couldn't open socket: not owner}

if {0} {
    package require tls

    proc accept {s a p} {
	puts [info level 0]
	expr 10 / 0
    }
    set s [tls::socket -server accept 8848]

    proc bgerror args { puts "bgerror: $args" }
    set s [tls::socket zamora.scriptics.com 8848]
}

test tlsIO-6.1 {accept callback error} { socket stdio pcCrash} {
    # HOBBS: still fails post-rewrite


    removeFile script
    set f [open script w]
    puts $f {
    	package require tls
	gets stdin
	tls::socket 127.0.0.1 8848
    }

    close $f
    set f [open "|[list $::tcltest::tcltest script]" r+]
    proc bgerror args {
	global x
	set x $args
    }
    proc accept {s a p} {expr 10 / 0}
    set s [tls::socket -server accept 8848]

    puts $f hello
    close $f
    set timer [after 10000 "set x timed_out"]
    vwait x
    after cancel $timer
    close $s
    rename bgerror {}
    set x
} {{divide by zero}}

# bug report #5812 fconfigure doesn't return value for '-peername'

test tlsIO-7.1 {testing socket specific options} {socket stdio} {
    removeFile script
    set f [open script w]
    puts $f {
	package require tls
    }

    puts $f "tls::socket -server accept -certfile $serverCert -cafile $caCert -keyfile $serverKey 8820"
    puts $f {
	proc accept args {
	    global x
	    set x done
	}
	puts ready
	set timer [after 10000 "set x timed_out"]
................................................................................
    close $f
    set l ""
    lappend l [string compare [lindex $p 0] 127.0.0.1]
    lappend l [string compare [lindex $p 2] 8820]
    lappend l [llength $p]
} {0 0 3}

# bug report #5812 fconfigure doesn't return value for '-sockname'

test tlsIO-7.2 {testing socket specific options} {socket stdio} {
    removeFile script
    set f [open script w]
    puts $f {
	package require tls
    }
    puts $f "tls::socket -server accept -certfile $serverCert -cafile $caCert -keyfile $serverKey 8821"
................................................................................
    vwait x
    if {!$failed} {
	vwait failed
    }
    set x
} {client socket was not inherited}

test tlsIO-12.3 {testing inheritance of accepted sockets} {socket exec} {

    makeFile {} script1
    makeFile {} script2

    set f [open script1 w]
    puts $f {
	after 10000 exit
	vwait forever







|







 







|
>
>
>







 







>







 







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





<

>







|
>










<
<






>
|







 







<
<







 







|
>







6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
...
669
670
671
672
673
674
675
676
677
678
679
680
681
682
683
684
685
686
...
796
797
798
799
800
801
802
803
804
805
806
807
808
809
810
...
901
902
903
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
931
932
933
934
935
936


937
938
939
940
941
942
943
944
945
946
947
948
949
950
951
...
963
964
965
966
967
968
969


970
971
972
973
974
975
976
....
1831
1832
1833
1834
1835
1836
1837
1838
1839
1840
1841
1842
1843
1844
1845
1846
#
# Copyright (c) 1994-1996 Sun Microsystems, Inc.
# Copyright (c) 1998-2000 Ajuba Solutions. 
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
#
# RCS: @(#) $Id: tlsIO.test,v 1.14.2.5 2000/07/26 23:11:46 hobbs Exp $

# Running socket tests with a remote server:
# ------------------------------------------
# 
# Some tests in socket.test depend on the existence of a remote server to
# which they connect. The remote server must be an instance of tcltest and it
# must run the script found in the file "remote.tcl" in this directory. You
................................................................................
    fconfigure $sock -blocking 1
    close $s2
    close $s
    close $sock
    set result
} {a:one b: c:two}

test tlsIO-2.12 {tcp connection; no certificates specified} \
	{socket stdio unixOnly} {
    # There is a debug assertion on Windows/SSL that causes a crash when the
    # certificate isn't specified.
    removeFile script
    set f [open script w]
    puts $f {
    	package require tls
	set timer [after 2000 "set x timed_out"]
	set f [tls::socket -server accept 8828]
	proc accept {file addr port} {
................................................................................
    close $s3
    lappend x [gets $f]
    close $f
    set x
} {ready done}

test tlsIO-4.1 {server with several clients} {socket stdio} {
    # have seen intermittent hangs on Windows
    removeFile script
    set f [open script w]
    puts $f {
    	package require tls
	gets stdin
    }
    puts $f "set s \[tls::socket -certfile $clientCert -cafile $caCert -keyfile $clientKey 127.0.0.1 8828 \]"
................................................................................
    if {![catch {tls::socket -server dodo 21} msg]} {
	set x {htons problem, should be disallowed, are you running as SU?}
	close $msg
    }
    set x
} {couldn't open socket: not owner}














test tlsIO-6.1 {accept callback error} {socket stdio} {

    # There is a debug assertion on Windows/SSL that causes a crash when the
    # certificate isn't specified.
    removeFile script
    set f [open script w]
    puts $f {
    	package require tls
	gets stdin

    }
    puts $f [list tls::socket -cafile $caCert 127.0.0.1 8848]
    close $f
    set f [open "|[list $::tcltest::tcltest script]" r+]
    proc bgerror args {
	global x
	set x $args
    }
    proc accept {s a p} {expr 10 / 0}
    set s [tls::socket -server accept \
	    -certfile $serverCert -cafile $caCert -keyfile $serverKey 8848]
    puts $f hello
    close $f
    set timer [after 10000 "set x timed_out"]
    vwait x
    after cancel $timer
    close $s
    rename bgerror {}
    set x
} {{divide by zero}}



test tlsIO-7.1 {testing socket specific options} {socket stdio} {
    removeFile script
    set f [open script w]
    puts $f {
	package require tls
    }
    puts $f [list tls::socket -server accept \
	    -certfile $serverCert -cafile $caCert -keyfile $serverKey 8820]
    puts $f {
	proc accept args {
	    global x
	    set x done
	}
	puts ready
	set timer [after 10000 "set x timed_out"]
................................................................................
    close $f
    set l ""
    lappend l [string compare [lindex $p 0] 127.0.0.1]
    lappend l [string compare [lindex $p 2] 8820]
    lappend l [llength $p]
} {0 0 3}



test tlsIO-7.2 {testing socket specific options} {socket stdio} {
    removeFile script
    set f [open script w]
    puts $f {
	package require tls
    }
    puts $f "tls::socket -server accept -certfile $serverCert -cafile $caCert -keyfile $serverKey 8821"
................................................................................
    vwait x
    if {!$failed} {
	vwait failed
    }
    set x
} {client socket was not inherited}

test tlsIO-12.3 {testing inheritance of accepted sockets} \
	{socket exec unixOnly} {
    makeFile {} script1
    makeFile {} script2

    set f [open script1 w]
    puts $f {
	after 10000 exit
	vwait forever