|
1 #!/usr/bin/tclsh |
|
2 # |
|
3 # Simple tcl script to generate a static topology of dtn links and |
|
4 # routes for a network. |
|
5 # |
|
6 |
|
7 # |
|
8 # Graph specification. |
|
9 # |
|
10 # The active connector (ALWAYSON) host is on the left, the passive |
|
11 # acceptor (OPPORTUNISTIC) on the right. IP addresses can be specified |
|
12 # either explicitly using host,addr or by using the addr array for |
|
13 # single-homed machines. |
|
14 # |
|
15 set links { |
|
16 sandbox,1.1.1.1 pisco |
|
17 wangari sandbox,2.2.2.2 |
|
18 ica sandbox,3.3.3.3 |
|
19 shirin wangari |
|
20 } |
|
21 |
|
22 # |
|
23 # Node address specification (optional) for single-homed machines. |
|
24 # |
|
25 set addr(pisco) 128.32.1.1 |
|
26 set addr(shirin) 3.4.5.7 |
|
27 set addr(wangari) 3.4.5.6 |
|
28 set addr(ica) 10.212.1.1 |
|
29 |
|
30 # |
|
31 # Link options (not currently implemented) |
|
32 # |
|
33 set link_options(*) segment_size=1024 |
|
34 set link_options(pisco-*) keepalive_interval=2 |
|
35 |
|
36 # |
|
37 # Common config for all nodes |
|
38 # |
|
39 set COMMON_CONFIG \ |
|
40 { |
|
41 set localhost [lindex [split [info hostname] .] 0] |
|
42 |
|
43 console set prompt "$localhost dtn% " |
|
44 console set addr localhost |
|
45 console set port 5050 |
|
46 |
|
47 storage set type filesysdb |
|
48 storage set payloaddir /extra/dtn/bundles |
|
49 storage set dbname DTN |
|
50 storage set dbdir /extra/dtn/db |
|
51 |
|
52 route set type static |
|
53 interface add tcp0 tcp |
|
54 } |
|
55 |
|
56 #----------------------------------------------------------------------------- |
|
57 # |
|
58 # Graph IMPLEMENTATION STARTS HERE |
|
59 # |
|
60 |
|
61 |
|
62 # |
|
63 # first build the list of all hosts |
|
64 # |
|
65 set allhosts [array names addr] |
|
66 foreach h $links { |
|
67 set h [lindex [split $h ,] 0] |
|
68 if {[lsearch $allhosts $h] == -1} { |
|
69 lappend allhosts $h |
|
70 } |
|
71 } |
|
72 |
|
73 # build a full_links list as {host1 addr1 host2 addr2} quads |
|
74 set l2 {} |
|
75 foreach link $links { |
|
76 foreach {h a} [split $link ,] {} |
|
77 if {$a == ""} { |
|
78 if {! [info exists addr($h)] || [llength $addr($h)] > 1} { |
|
79 error "need unique address specification for host $h in link {$src - $dst}" |
|
80 } |
|
81 set a $addr($h) |
|
82 } |
|
83 |
|
84 lappend l2 $h |
|
85 lappend l2 $a |
|
86 } |
|
87 set links $l2 |
|
88 |
|
89 # find all reachable nodes starting from the link src -> dst |
|
90 proc reachable {src dst} { |
|
91 set visited $src |
|
92 reachable2 visited $dst |
|
93 return $visited |
|
94 } |
|
95 proc reachable2 {visitedVar host} { |
|
96 upvar $visitedVar visited |
|
97 global links |
|
98 lappend visited $host |
|
99 |
|
100 foreach {host1 addr1 host2 addr2} $links { |
|
101 if {$host1 == $host && [lsearch $visited $host2] == -1} { |
|
102 reachable2 visited $host2 |
|
103 } elseif {$host2 == $host && [lsearch $visited $host1] == -1} { |
|
104 reachable2 visited $host1 |
|
105 } |
|
106 } |
|
107 } |
|
108 |
|
109 # proc to return the link options between two hosts |
|
110 proc link_opts {parent child} { |
|
111 return "" |
|
112 } |
|
113 |
|
114 # generate the config |
|
115 puts "#\n# DTN Configuration generated [clock format [clock seconds]]\n#" |
|
116 puts $COMMON_CONFIG |
|
117 |
|
118 puts "switch -exact \$localhost \{" |
|
119 foreach host [lsort $allhosts] { |
|
120 puts " $host \{" |
|
121 puts " route local_eid dtn://$host.dtn" |
|
122 |
|
123 foreach {host1 addr1 host2 addr2} $links { |
|
124 if {$host == $host1} { |
|
125 set dst $host2 |
|
126 set dst_addr $addr2 |
|
127 set type ALWAYSON |
|
128 } elseif {$host == $host2} { |
|
129 set dst $host1 |
|
130 set dst_addr $addr1 |
|
131 set type OPPORTUNISTIC |
|
132 } else { |
|
133 continue |
|
134 } |
|
135 |
|
136 puts " link add l-$dst $dst_addr:4556 $type tcp [link_opts $host $dst]" |
|
137 foreach n [reachable $host $dst] { |
|
138 if {$host != $n} { |
|
139 puts " route add dtn://$n.dtn/* l-$dst" |
|
140 } |
|
141 } |
|
142 } |
|
143 puts " \}" |
|
144 } |
|
145 puts "\}" |
|
146 |