|
1 # |
|
2 # Copyright 2006 Intel Corporation |
|
3 # |
|
4 # Licensed under the Apache License, Version 2.0 (the "License"); |
|
5 # you may not use this file except in compliance with the License. |
|
6 # You may obtain a copy of the License at |
|
7 # |
|
8 # http://www.apache.org/licenses/LICENSE-2.0 |
|
9 # |
|
10 # Unless required by applicable law or agreed to in writing, software |
|
11 # distributed under the License is distributed on an "AS IS" BASIS, |
|
12 # WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. |
|
13 # See the License for the specific language governing permissions and |
|
14 # limitations under the License. |
|
15 # |
|
16 |
|
17 test::name writeblocked.tcl |
|
18 net::num_nodes 2 |
|
19 |
|
20 set cl tcp |
|
21 |
|
22 foreach {var val} $opt(opts) { |
|
23 if {$var == "-cl" || $var == "cl"} { |
|
24 set cl $val |
|
25 } else { |
|
26 testlog error "ERROR: unrecognized test option '$var'" |
|
27 exit 1 |
|
28 } |
|
29 } |
|
30 |
|
31 dtn::config |
|
32 dtn::config_interface $cl |
|
33 dtn::config_linear_topology ALWAYSON $cl true \ |
|
34 "test_read_delay=500 segment_length=1000" |
|
35 |
|
36 test::script { |
|
37 testlog "Running dtnds" |
|
38 dtn::run_dtnd * |
|
39 |
|
40 testlog "Waiting for dtnds to start up" |
|
41 dtn::wait_for_dtnd * |
|
42 |
|
43 dtn::tell_dtnd 0 tcl_registration dtn://host-0/test |
|
44 dtn::tell_dtnd 1 tcl_registration dtn://host-1/test |
|
45 |
|
46 testlog "Waiting for links to open" |
|
47 dtn::wait_for_link_state 0 $cl-link:0-1 OPEN |
|
48 dtn::wait_for_link_state 1 $cl-link:1-0 OPEN |
|
49 |
|
50 testlog "Shrinking send/recv buffers" |
|
51 dtn::tell_dtnd 0 link reconfigure $cl-link:0-1 \ |
|
52 sendbuf_len=1000 recvbuf_len=1000 |
|
53 |
|
54 dtn::tell_dtnd 1 link reconfigure $cl-link:1-0 \ |
|
55 sendbuf_len=1000 recvbuf_len=1000 |
|
56 |
|
57 set N 20 |
|
58 testlog "Sending $N bundles in one direction" |
|
59 for {set i 0} {$i < $N} {incr i} { |
|
60 set timestamp($i) [dtn::tell_dtnd 1 sendbundle \ |
|
61 dtn://host-1/test dtn://host-0/test length=5000] |
|
62 } |
|
63 |
|
64 testlog "Dumping stats" |
|
65 dtn::dump_stats |
|
66 |
|
67 for {set i 0} {$i < $N} {incr i} { |
|
68 testlog "Waiting for arrival of bundle $i" |
|
69 dtn::wait_for_bundle 0 "dtn://host-1/test,$timestamp($i)" 10 |
|
70 } |
|
71 |
|
72 testlog "Doing sanity check on stats" |
|
73 dtn::wait_for_bundle_stats 0 "0 pending $N received $N delivered" |
|
74 dtn::wait_for_bundle_stats 1 "0 pending $N transmitted" |
|
75 |
|
76 unset timestamp |
|
77 tell_dtnd * bundle reset_stats |
|
78 |
|
79 testlog "Sending $N bundles in both directions" |
|
80 for {set i 0} {$i < $N} {incr i} { |
|
81 set timestamp(0,$i) [dtn::tell_dtnd 0 sendbundle \ |
|
82 dtn://host-0/test dtn://host-1/test length=4096] |
|
83 |
|
84 set timestamp(1,$i) [dtn::tell_dtnd 1 sendbundle \ |
|
85 dtn://host-1/test dtn://host-0/test length=4096] |
|
86 } |
|
87 |
|
88 testlog "Dumping stats" |
|
89 dtn::dump_stats |
|
90 |
|
91 for {set i 0} {$i < $N} {incr i} { |
|
92 testlog "Waiting for arrival of bundle $i at each node" |
|
93 dtn::wait_for_bundle 0 "dtn://host-1/test,$timestamp(1,$i)" 10 |
|
94 dtn::wait_for_bundle 1 "dtn://host-0/test,$timestamp(0,$i)" 10 |
|
95 } |
|
96 |
|
97 testlog "Doing sanity check on stats" |
|
98 dtn::wait_for_bundle_stats 0 "0 pending [expr $N * 2] received $N delivered" |
|
99 dtn::wait_for_bundle_stats 1 "0 pending [expr $N * 2] received $N delivered" |
|
100 dtn::wait_for_bundle_stats 0 "0 pending $N transmitted" |
|
101 dtn::wait_for_bundle_stats 1 "0 pending $N transmitted" |
|
102 |
|
103 testlog "Resetting stats" |
|
104 dtn::tell_dtnd * bundle reset_stats |
|
105 |
|
106 testlog "Clearing the read_delay" |
|
107 dtn::tell_dtnd 0 link reconfigure $cl-link:0-1 \ |
|
108 test_read_delay=0 segment_length=[expr 100 * 1024] |
|
109 dtn::tell_dtnd 1 link reconfigure $cl-link:1-0 \ |
|
110 test_read_delay=0 segment_length=[expr 100 * 1024] |
|
111 |
|
112 testlog "Upping the block length" |
|
113 dtn::tell_dtnd 0 link reconfigure $cl-link:0-1 segment_length=[expr 100 * 1024] |
|
114 dtn::tell_dtnd 1 link reconfigure $cl-link:1-0 segment_length=[expr 100 * 1024] |
|
115 |
|
116 testlog "Growing the send/recv buffers" |
|
117 dtn::tell_dtnd 0 link reconfigure $cl-link:0-1 sendbuf_len=32768 recvbuf_len=32768 |
|
118 dtn::tell_dtnd 1 link reconfigure $cl-link:1-0 sendbuf_len=32768 recvbuf_len=32768 |
|
119 |
|
120 testlog "Sending a 5MB bundle in each direction" |
|
121 set timestamp_0 [dtn::tell_dtnd 0 bundle inject dtn://host-0/test dtn://host-1/test "payload" length=[expr 10 * 1024 * 1024] ] |
|
122 set timestamp_1 [dtn::tell_dtnd 1 bundle inject dtn://host-1/test dtn://host-0/test "payload" length=[expr 10 * 1024 * 1024] ] |
|
123 |
|
124 testlog "Waiting for delivery of the bundles" |
|
125 dtn::wait_for_bundle 0 "dtn://host-1/test,$timestamp_1" 60 |
|
126 dtn::wait_for_bundle 1 "dtn://host-0/test,$timestamp_0" 60 |
|
127 testlog "Test success!" |
|
128 } |
|
129 |
|
130 test::exit_script { |
|
131 testlog "Stopping all dtnds" |
|
132 dtn::stop_dtnd * |
|
133 } |