File: host-test.tcl

package info (click to toggle)
openswan 1%3A2.4.6%2Bdfsg.2-1.1
  • links: PTS
  • area: main
  • in suites: etch-m68k
  • size: 24,996 kB
  • ctags: 16,877
  • sloc: ansic: 121,112; sh: 19,524; xml: 9,699; asm: 4,422; perl: 4,087; makefile: 3,367; tcl: 713; exp: 657; yacc: 396; pascal: 328; lex: 289; sed: 265; awk: 124; lisp: 3
file content (322 lines) | stat: -rw-r--r-- 8,640 bytes parent folder | download | duplicates (2)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
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
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
#!/usr/bin/expect --

#
# $Id: host-test.tcl,v 1.38 2004/09/15 21:50:32 mcr Exp $
#

source $env(OPENSWANSRCDIR)/testing/utils/GetOpts.tcl
source $env(OPENSWANSRCDIR)/testing/utils/netjig.tcl

proc usage {} {
    global argv0

    puts stderr "Usage: $argv0 "
    puts stderr "\t-i <script>        script to initialize UML"
    puts stderr "\t-s <script>        script to run before data flows"
    puts stderr "\t-I <script>        script to finalize UML"
    puts stderr "\t-n <netjigprog>    path to netjig program"
    puts stderr "\t-a                 if netjig should enable --arpreply"
    puts stderr "\t-D                 start up the UML nic so that there is DNS"
    puts stderr "\t-H host=path,host=path start up additional UMLs as specified"
    puts stderr "\t-p <file>          pcap file to play on private network"
    puts stderr "\t-P <file>          pcap file to play on public network"
    puts stderr "\t-r <file>          record private network to file"
    puts stderr "\t-R <file>          record public network to file"
    puts stderr "\t-u <uml>           User Mode Linux program to start"
    puts stderr "\t-c <file>          file to send console output to"
    puts stderr "\n"
    puts stderr "The following environment variables are also consulted:\n"
    puts stderr "PACKETRATE\tthe rate at which packets will be replayed"
    exit 22
}

set do_playprivate   0
set do_playpublic    0
set do_recordprivate 0
set do_recordpublic  0
set do_consoleoutput 0
set do_dns           0
set timeout 300
set netjig_wait_user 0
log_user 0
if {[info exists env(HOSTTESTDEBUG)]} {
    if {$env(HOSTTESTDEBUG) == "hosttest"} {
	log_user 1
    }
}
set netjig_debug_opt ""
if {[info exists env(NETJIGTESTDEBUG)]} {
    if {$env(NETJIGTESTDEBUG) == "netjig"} {
	set netjig_debug_opt "--debug"
    }
}

if {[info exists env(NETJIGWAITUSER)]} {
    if {$env(NETJIGWAITUSER) == "waituser"} {
	set netjig_wait_user 1
    }
}

netjigdebug "Program invoked with $argv"
set arpreply ""
set umlid(extra_hosts) ""

while { [ set err [ getopt $argv "c:D:H:i:I:n:ap:P:r:R:s:u:U:" opt optarg]] } {
    if { $err < 0 } then {
	puts stderr "$argv0: $opt and $optarg" 
	usage
    } else {
	#puts stderr "Opt $opt arg: $optarg"

	switch -exact $opt {
	    c {
		set umlid(uml,consolefile) $optarg
	    }
	    D {
		process_extra_host "nic=$optarg"
	    }
	    u {
		set umlid(uml,program)    $optarg
	    }
	    U {
		set umlid(uml,host)    $optarg
	    }
	    H {
		# format of arg is host=program[, ]host=program.
		process_extra_host $optarg
	    }
	    i {
		set umlid(uml,initscript) $optarg
	    }
	    I {
		set umlid(uml,finalscript) $optarg
	    }
	    s { 
		set umlid(uml,runscript)   $optarg
            }
	    n {
		set netjig_prog $optarg
	    }
	    a {
		set arpreply "--arpreply"
	    }
	    p {
		set playprivate $optarg
		set do_playprivate 1
	    }
	    P {
		set playpublic $optarg
		set do_playpublic 1
	    }
	    r {
		set recordprivate $optarg
		set do_recordprivate 1
	    }
	    R {
		set recordpublic $optarg
		set do_recordpublic 1
	    }
	}
    }
}

set argv [ lrange $argv $optind end ]

set managed_hosts {}
lappend managed_hosts $umlid(uml,host) 

if {! [file executable $netjig_prog]} {
    puts "The NETJIG management program is not present. Did you run \"make check\"?"
    exit
}

netjigdebug "Starting up the netjig program: $netjig_prog"

netjigdebug "Will start additional hosts: $umlid(extra_hosts)"

# we start up netjig_prog with a plain pipe, so that
# stderr from it will go to our stderr.
spawn -noecho -open [open "|$netjig_prog --cmdproto -t $netjig_debug_opt 2>@stderr" w+]
set netjig1 $spawn_id

netjigsetup $netjig1

newswitch $netjig1 "$arpreply public"
newswitch $netjig1 "$arpreply private"

# this just gets rid of issues with running without a mcast address
newswitch $netjig1 "$arpreply admin"

trace variable expect_out(buffer) w log_by_tracing

# start up auxiliary hosts first
foreach host $umlid(extra_hosts) {
    startuml $host
    loginuml $host
    initdns  $host
}

startuml uml
loginuml uml
inituml  uml

if { $do_recordpublic == 1 } {
    record $netjig1 public $recordpublic
}

if { $do_recordprivate == 1 } {
    record $netjig1 private $recordprivate
}

if { $do_playpublic == 1 } {
    setupplay $netjig1 public $playpublic
}

if { $do_playprivate == 1 } {
    setupplay $netjig1 private $playprivate
}

runuml uml

# let things settle.
after 500

if { $do_playpublic == 1 || $do_playprivate == 1 } {
    waitplay $netjig1
}

if { $netjig_wait_user == 1 } {
    set old_timeout $timeout
    puts -nonewline stderr "PLEASE PRESS ENTER TO TERMINATE TEST"
    set timeout -1
    expect_user -gl "\n"
    set timeout $old_timeout
}

netjigdebug "Finished tests, shutting down"

after 500

# suck up whatever came out
#expect -i $umlid(uml,spawnid) -gl "*"

#send -i $umlid(uml,spawnid) "\r"

killuml uml
foreach host $umlid(extra_hosts) {
    killdns $host
}

send -i $netjig1 "QUIT\n"
expect {
	-i $netjig1
	timeout { puts "timeout awaiting EOF in host-test.tcl" }
	eof
}

system "sleep 4"

# 
# $Log: host-test.tcl,v $
# Revision 1.38  2004/09/15 21:50:32  mcr
# 	sleep after the test case finishes to give the UML time
# 	to exit cleanly.
#
# Revision 1.37  2004/04/16 19:55:45  mcr
# 	create "admin" network for "eth2" use.
#
# Revision 1.36  2004/04/03 19:44:52  ken
# FREESWANSRCDIR -> OPENSWANSRCDIR (patch by folken)
#
# Revision 1.35  2003/10/31 02:43:34  mcr
# 	pull up of port-selector tests
#
# Revision 1.34  2003/10/28 03:03:33  dhr
#
# Refine testing scripts:
# - put timeout and eof handlers in each expect script
# - kill more rogue processes: even those with unreadable(!) /proc entries
# - improve reporting of skipped tests
# - make "recordresults" do more, simplifying every caller
# - speed up UML shutdown by using "halt -p -r" (requires many reference log updates)
#
# Revision 1.33  2003/04/02 20:26:53  mcr
# 	quiet down host-test.tcl by using netjigdebug.
#
# Revision 1.32  2003/04/02 02:24:44  mcr
# 	added PACKETRATE setting to host-test.tcl
#
# Revision 1.31  2002/11/04 04:56:09  mcr
# 	when waiting for the user to finish test (NETJIGWAITUSER=waituser)
# 	it is best to wait forever, rather than just until the timeout.
#
# Revision 1.30  2002/11/02 23:03:02  mcr
# 	use new "killdns" function to stop extra hosts.
# 	do not attempt to load module, etc. on extra hosts.
#
# Revision 1.29  2002/11/01 04:17:45  mcr
# 	make sure to initialize umlid(extra_hosts), for the cases
# 	when there are no ADDITIONAL_HOSTS.
#
# Revision 1.28  2002/11/01 02:28:02  mcr
# 	added -H option to *host-test.tcl so give list of additional
# 	hosts that should be started. This is in the form of
# 	host=program,host=program.
# 	Fixed up -D (use DNS) option to instead use the additional
# 	host mechanism.
#
# 	Added "ADDITIONAL_HOSTS" variable to provide a list of
# 	additional hosts that should be started for a given test.
#
# Revision 1.27  2002/10/31 19:01:20  mcr
# 	for consistency, "RUN_SCRIPT" is implemented for "klipstest"
# 	as well as "plutoumltests".
#
# Revision 1.26  2002/10/31 18:51:36  mcr
# 	renamed old "runuml" to "waitplay".
# 	made new function "runuml" which runs a script after
# 	the init, but before the packets start to flow.
# 	There are new variables RUN_{EAST,WEST}_SCRIPT.
#
# Revision 1.25  2002/09/30 18:57:57  mcr
# 	add option "NEED_DNS=true" to start up "nic" UML
# 	for single and 2-host tests. Enabled for "ctltest" only
# 	for now for dns testing.
#
# Revision 1.24  2002/09/18 18:21:40  mcr
# 	if $NETJIGWAITUSER == "waituser" then prompt the user
# 	interactively before terminating test. Useful when debugging.
#
# Revision 1.23  2002/09/02 19:33:45  mcr
# 	the WAITPLAY command did work - it signaled end of
# 	packet stream, but then forgot this fact, and didn't
# 	actually exit.
# 	The netjig.tcl will now log to stderr any problems talking
# 	to uml_netjig, so this problem will be more obvious in
# 	the future.
#
# Revision 1.22  2002/08/29 23:45:23  mcr
# 	fixed up "ctltest" test type
#
# Revision 1.21  2002/08/26 03:15:23  mcr
# 	use "killuml" function only - it now plays the finalscript,
# 	if there is one.
#
# Revision 1.20  2002/08/22 17:42:19  mcr
# 	do not send \r at end of tests, as it is hard
# 	to find one versus two prompts.
#
# Revision 1.19  2002/08/21 21:53:38  mcr
# 	introduced "killuml" function to collect exit behaviour
# 	in one place.
#
# Revision 1.18  2002/08/02 22:31:24  mcr
# 	adjusted to use functions from netjig.tcl
#
# Revision 1.17  2002/07/25 20:09:49  mcr
# 	remove <<<< merge error from end of file.
#
# Revision 1.16  2002/07/23 17:01:32  mcr
# 	added RCS ids
#
#