← Back to branch summary

~ubuntu-branches/ubuntu/hardy/tcltls/hardy

« back to all changes in this revision

Viewing changes to tests/oldTests/tlsSrv.tcl

  • Committer: Bazaar Package Importer
  • Author(s): Søren Boll Overgaard
  • Date: 2004-06-16 19:22:30 UTC
  • Revision ID: james.westby@ubuntu.com-20040616192230-tv159811lsnerauf
Tags: upstream-1.5.0
Import upstream version 1.5.0

Show diffs side-by-side

added added

removed removed

Lines of Context:
tests/oldTests/tlsSrv.tcl
 
1
#
 
2
# Copyright (C) 1997-2000 Matt Newman <matt@novadigm.com>
 
3
#
 
4
# $Header: /cvsroot/tls/tls/tests/oldTests/tlsSrv.tcl,v 1.1 2000/06/06 18:13:21 aborr Exp $
 
5
#
 
6
# Sample Tls-enabled server
 
7
#
 
8
set dir [file dirname [info script]]
 
9
cd $dir
 
10
source tls.tcl
 
11
#lappend auto_path d:/tcl80/lib
 
12
#package require tls
 
13
 
 
14
#
 
15
# Sample callback - just reflect data back to client
 
16
#
 
17
proc reflectCB {chan {verbose 0}} {
 
18
    set x hello
 
19
    if {[catch {read $chan 1024} data]} {
 
20
        puts stderr "EOF ($data)"
 
21
        catch {close $chan}
 
22
        return
 
23
    }
 
24
        
 
25
    if {$verbose && $data != ""} {
 
26
        puts -nonewline stderr $data
 
27
    }
 
28
    if {[eof $chan]} {    ;# client gone or finished
 
29
        puts stderr "EOF"
 
30
        close $chan        ;# release the servers client channel
 
31
        return
 
32
    }
 
33
    puts -nonewline $chan $data
 
34
    flush $chan
 
35
}
 
36
proc acceptCB { chan ip port } {
 
37
    puts "accept: $chan $ip $port [fconfigure $chan]"
 
38
    if {[catch {
 
39
        tls::handshake $chan
 
40
    } err]} {
 
41
        catch {close $chan}
 
42
        return
 
43
    }
 
44
    puts [tls::status $chan]
 
45
 
 
46
    fconfigure $chan -buffering none -blocking 0
 
47
    fileevent $chan readable [list reflectCB $chan 1]
 
48
}
 
49
#tls::init -cafile server.pem -certfile server.pem 
 
50
tls::init -cafile server.pem
 
51
#tls::init 
 
52
 
 
53
set chan [tls::socket -server acceptCB \
 
54
                -request 1 -require 0 1234]
 
55
#               -require 1 -command tls::callback 1234]
 
56
 
 
57
puts "Server waiting connection on $chan (1234)"
 
58
puts [fconfigure $chan]
 
59
 
 
60
# Go into the eventloop
 
61
vwait /Exit