Check-in [5ed815df85]
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 on 2000-07-26 23:11:46
Other Links: branch diff | manifest | tags
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
Modified ChangeLog from [2accd518be] to [109956acd8].
1



2
3
4
5
6
7
8
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
1
2
3
4
5
6
7
8
9
10
11
12
13

14
15
16
17
18
19
20
1
2
3
4
5
6
7
8
9
10
11
12

13
14
15
16
17
18
19
20












-
+







# Commands tested in this file: socket.
#
# This file contains a collection of tests for one or more of the Tcl
# built-in commands.  Sourcing this file into Tcl runs the tests and
# generates output for errors.  No output means no errors were found.
#
# 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 $
# 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
669
670
671
672
673
674
675
676




677
678
679
680
681
682
683
669
670
671
672
673
674
675

676
677
678
679
680
681
682
683
684
685
686







-
+
+
+
+







    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} {
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} {
793
794
795
796
797
798
799

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







+







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







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





-

+







-
+
+










-
-






+
-
+







    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

test tlsIO-6.1 {accept callback error} {socket stdio} {
    proc accept {s a p} {
	puts [info level 0]
	expr 10 / 0
    }
    set s [tls::socket -server accept 8848]

    # There is a debug assertion on Windows/SSL that causes a crash when the
    proc bgerror args { puts "bgerror: $args" }
    set s [tls::socket zamora.scriptics.com 8848]
}

    # certificate isn't specified.
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
    }
    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 8848]
    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}}

# 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 [list tls::socket -server accept \
    puts $f "tls::socket -server accept -certfile $serverCert -cafile $caCert -keyfile $serverKey 8820"
	    -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"]
971
972
973
974
975
976
977
978
979
980
981
982
983
984
985
986
963
964
965
966
967
968
969


970
971
972
973
974
975
976







-
-







    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"
1841
1842
1843
1844
1845
1846
1847
1848


1849
1850
1851
1852
1853
1854
1855
1831
1832
1833
1834
1835
1836
1837

1838
1839
1840
1841
1842
1843
1844
1845
1846







-
+
+







    vwait x
    if {!$failed} {
	vwait failed
    }
    set x
} {client socket was not inherited}

test tlsIO-12.3 {testing inheritance of accepted sockets} {socket exec} {
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