|
1 # |
|
2 # Copyright 2005-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 # |
|
18 # Basic configuration proc for test dtnd's |
|
19 # |
|
20 |
|
21 namespace eval dtn { |
|
22 |
|
23 proc config {args} { |
|
24 conf::add dtnd * {source "dtnd-test-utils.tcl"} |
|
25 |
|
26 # defaults |
|
27 set router_type static |
|
28 set storage_type berkeleydb |
|
29 set null_link true |
|
30 set copy_executables true |
|
31 |
|
32 set i 0 |
|
33 while {$i < [llength $args]} { |
|
34 set arg [lindex $args $i] |
|
35 switch -- $arg { |
|
36 -router_type - |
|
37 --router_type { |
|
38 set router_type [lindex $args [incr i]] |
|
39 } |
|
40 -storage_type - |
|
41 --storage_type { |
|
42 set storage_type [lindex $args [incr i]] |
|
43 } |
|
44 -no_null_link - |
|
45 --no_null_link { |
|
46 set null_link false |
|
47 } |
|
48 -no_copy_executables { |
|
49 set copy_executables false |
|
50 } |
|
51 |
|
52 default { |
|
53 error "unknown dtn::config argument '$arg'" |
|
54 } |
|
55 } |
|
56 |
|
57 incr i |
|
58 } |
|
59 |
|
60 dtn::standard_manifest $copy_executables |
|
61 dtn::config_console |
|
62 dtn::config_api_server |
|
63 dtn::config_storage $storage_type |
|
64 # if {$null_link} { |
|
65 # dtn::config_null_link |
|
66 # } |
|
67 |
|
68 set dtn::router_type $router_type |
|
69 dtn::config_dtntest |
|
70 } |
|
71 |
|
72 # |
|
73 # Standard manifest |
|
74 # |
|
75 proc standard_manifest {copy_executables} { |
|
76 global opt |
|
77 if {$copy_executables} { |
|
78 manifest::file daemon/dtnd dtnd |
|
79 } |
|
80 manifest::file [file join $opt(base_test_dir) \ |
|
81 test-utils/dtnd-test-utils.tcl] dtnd-test-utils.tcl |
|
82 manifest::dir bundles |
|
83 manifest::dir db |
|
84 } |
|
85 |
|
86 proc config_app_manifest {copy_executables {apps "dtnsend dtnrecv" } } { |
|
87 global opt |
|
88 if {$copy_executables} { |
|
89 foreach app $apps { |
|
90 manifest::file apps/$app/$app $app |
|
91 } |
|
92 } |
|
93 } |
|
94 |
|
95 # |
|
96 # Utility proc to get the adjusted port number for various things |
|
97 # |
|
98 proc get_port {what id} { |
|
99 global net::portbase net::used_ports |
|
100 set dtn_portbase $net::portbase($id) |
|
101 |
|
102 switch -- $what { |
|
103 console { set port [expr $dtn_portbase + 0] } |
|
104 api { set port [expr $dtn_portbase + 1] } |
|
105 tcp { set port [expr $dtn_portbase + 2] } |
|
106 udp { set port [expr $dtn_portbase + 2] } |
|
107 ltp { set port [expr $dtn_portbase + 2] } |
|
108 dtntest { set port [expr $dtn_portbase + 3] } |
|
109 misc { set port [expr $dtn_portbase + 4] } |
|
110 default { return -1 } |
|
111 } |
|
112 lappend net::used_ports($id) $port |
|
113 return $port |
|
114 } |
|
115 |
|
116 # |
|
117 # Utility proc to determine whether or not the given convergence layer |
|
118 # is bidirectional |
|
119 # |
|
120 proc is_bidirectional {cl} { |
|
121 switch -- $cl { |
|
122 tcp { return 1 } |
|
123 bt { return 1 } |
|
124 |
|
125 } |
|
126 |
|
127 return 0 |
|
128 } |
|
129 |
|
130 # |
|
131 # Create a new interface for the given convergence layer |
|
132 # |
|
133 proc config_interface {cl args} { |
|
134 global net::listen_addr |
|
135 foreach id [net::nodelist] { |
|
136 |
|
137 if {$cl == "bt"} { |
|
138 # first pass -- just take defaults ... figure out option parsing later |
|
139 conf::add dtnd $id [eval list interface add ${cl}0 $cl] |
|
140 } elseif {$cl == "ltp"} { |
|
141 set addr $net::listen_addr($id) |
|
142 set port [dtn::get_port $cl $id] |
|
143 conf::add dtnd $id [eval list interface add ${cl}0 $cl \ |
|
144 local_addr=[info hostname] local_port=$port $args] |
|
145 |
|
146 } else { |
|
147 set addr $net::listen_addr($id) |
|
148 set port [dtn::get_port $cl $id] |
|
149 conf::add dtnd $id [eval list interface add ${cl}0 $cl \ |
|
150 local_addr=$addr local_port=$port $args] |
|
151 } |
|
152 } |
|
153 } |
|
154 |
|
155 # |
|
156 # Configure the console server |
|
157 # |
|
158 proc config_console {} { |
|
159 global opt net::listen_addr |
|
160 foreach id [net::nodelist] { |
|
161 conf::add dtnd $id "console set addr $net::listen_addr($id)" |
|
162 conf::add dtnd $id "console set port [dtn::get_port console $id]" |
|
163 if {! $opt(xterm)} { |
|
164 conf::add dtnd $id "console set stdio false" |
|
165 } |
|
166 } |
|
167 } |
|
168 |
|
169 # |
|
170 # Set up the API server |
|
171 # |
|
172 proc config_api_server {} { |
|
173 foreach id [net::nodelist] { |
|
174 conf::add dtnd $id "api set local_addr $net::listen_addr($id)" |
|
175 conf::add dtnd $id "api set local_port [dtn::get_port api $id]" |
|
176 } |
|
177 } |
|
178 |
|
179 # |
|
180 # Set up a null link on each host |
|
181 # |
|
182 proc config_null_link {} { |
|
183 foreach id [net::nodelist] { |
|
184 conf::add dtnd $id "link add null /dev/null ALWAYSON null" |
|
185 } |
|
186 } |
|
187 |
|
188 # |
|
189 # Configure storage |
|
190 # |
|
191 proc config_storage {type} { |
|
192 set extra "" |
|
193 |
|
194 if {$type == "berkeleydb-no-txn"} { |
|
195 set type "berkeleydb" |
|
196 append extra "storage set db_txn false\n" |
|
197 append extra "storage set db_log false\n" |
|
198 } |
|
199 |
|
200 conf::add dtnd * [subst { |
|
201 storage set tidy_wait 0 |
|
202 storage set payloaddir bundles |
|
203 storage set type $type |
|
204 storage set dbname DTN |
|
205 storage set dbdir db |
|
206 $extra |
|
207 }] |
|
208 } |
|
209 |
|
210 # |
|
211 # Configure dtntest |
|
212 # |
|
213 proc config_dtntest {} { |
|
214 foreach id [net::nodelist] { |
|
215 conf::add dtntest $id \ |
|
216 "console set stdio false" |
|
217 conf::add dtntest $id \ |
|
218 "console set addr $net::listen_addr($id)" |
|
219 conf::add dtntest $id \ |
|
220 "console set port [dtn::get_port dtntest $id]" |
|
221 } |
|
222 } |
|
223 |
|
224 # namespace dtn |
|
225 } |