1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
|
# This file contains Tcl code to implement a remote server that can be
# used during testing of Tcl socket code. This server is used by some
# of the tests in socket.test.
#
# Source this file in the remote server you are using to test Tcl against.
#
# Copyright (c) 1995-1996 Sun Microsystems, Inc.
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
#
# RCS: @(#) $Id: remote.tcl,v 1.6 2004/02/11 22:41:25 razzell Exp $
|
>
>
<
|
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
|
#!/usr/bin/env tclsh
#
# This file contains Tcl code to implement a remote server that can be
# used during testing of Tcl socket code. This server is used by some
# of the tests in socket.test.
#
# Source this file in the remote server you are using to test Tcl against.
#
# Copyright (c) 1995-1996 Sun Microsystems, Inc.
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
#
# load tls package
package require tls
# Initialize message delimitor
# Initialize command array
|
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
|
}
}
proc __readAndExecute__ {s} {
global command VERBOSE
set l [gets $s]
if {[string compare $l "--Marker--Marker--Marker--"] == 0} {
if {[info exists command($s)]} {
puts $s [list error incomplete_command]
}
puts $s "--Marker--Marker--Marker--"
return
}
if {[string compare $l ""] == 0} {
if {[eof $s]} {
if {$VERBOSE} {
puts "Server closing $s, eof from client"
}
close $s
}
return
|
|
|
|
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
|
}
}
proc __readAndExecute__ {s} {
global command VERBOSE
set l [gets $s]
if {$l eq "--Marker--Marker--Marker--"} {
if {[info exists command($s)]} {
puts $s [list error incomplete_command]
}
puts $s "--Marker--Marker--Marker--"
return
}
if {$l eq ""} {
if {[eof $s]} {
if {$VERBOSE} {
puts "Server closing $s, eof from client"
}
close $s
}
return
|
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
|
tls::handshake $s
fileevent $s readable [list __readAndExecute__ $s]
fconfigure $s -buffering line -translation crlf
}
set serverIsSilent 0
for {set i 0} {$i < $argc} {incr i} {
if {[string compare -serverIsSilent [lindex $argv $i]] == 0} {
set serverIsSilent 1
break
}
}
if {![info exists serverPort]} {
if {[info exists env(serverPort)]} {
set serverPort $env(serverPort)
}
}
if {![info exists serverPort]} {
for {set i 0} {$i < $argc} {incr i} {
if {[string compare -port [lindex $argv $i]] == 0} {
if {$i < [expr $argc - 1]} {
set serverPort [lindex $argv [expr $i + 1]]
}
break
}
}
}
if {![info exists serverPort]} {
set serverPort 8048
}
if {![info exists serverAddress]} {
if {[info exists env(serverAddress)]} {
set serverAddress $env(serverAddress)
}
}
if {![info exists serverAddress]} {
for {set i 0} {$i < $argc} {incr i} {
if {[string compare -address [lindex $argv $i]] == 0} {
if {$i < [expr $argc - 1]} {
set serverAddress [lindex $argv [expr $i + 1]]
}
break
}
}
}
|
|
|
|
|
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
|
tls::handshake $s
fileevent $s readable [list __readAndExecute__ $s]
fconfigure $s -buffering line -translation crlf
}
set serverIsSilent 0
for {set i 0} {$i < $argc} {incr i} {
if {[lindex $argv $i] eq "-serverIsSilent"} {
set serverIsSilent 1
break
}
}
if {![info exists serverPort]} {
if {[info exists env(serverPort)]} {
set serverPort $env(serverPort)
}
}
if {![info exists serverPort]} {
for {set i 0} {$i < $argc} {incr i} {
if {[lindex $argv $i] eq "-port"} {
if {$i < [expr $argc - 1]} {
set serverPort [lindex $argv [expr $i + 1]]
}
break
}
}
}
if {![info exists serverPort]} {
set serverPort 8048
}
if {![info exists serverAddress]} {
if {[info exists env(serverAddress)]} {
set serverAddress $env(serverAddress)
}
}
if {![info exists serverAddress]} {
for {set i 0} {$i < $argc} {incr i} {
if {[lindex $argv $i] eq "-address"} {
if {$i < [expr $argc - 1]} {
set serverAddress [lindex $argv [expr $i + 1]]
}
break
}
}
}
|