Source file Topology.ml
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
open Core
module SDN = OpenFlow
module Net = struct
include Net.Net
include Net
end
let switch_ids (t : Net.Topology.t) : SDN.switchId list =
let open Net.Topology in
fold_vertexes (fun v acc ->
match vertex_to_label t v with
| Net.Switch id -> id::acc
| _ -> acc)
t []
let internal_ports (t : Net.Topology.t) (sw_id : SDN.switchId) =
let open Net.Topology in
let switch = vertex_of_label t (Switch sw_id) in
PortSet.fold (vertex_to_ports t switch) ~init:PortSet.empty ~f:(fun acc p ->
match next_hop t switch p with
| Some e ->
let node, _ = edge_dst e in
begin match vertex_to_label t node with
| Switch _ -> PortSet.add acc p
| _ -> acc
end
| _ -> acc)
let in_edge (t : Net.Topology.t) (sw_id : SDN.switchId) (pt_id : SDN.portId) =
let open Net.Topology in
let switch = vertex_of_label t (Switch sw_id) in
match next_hop t switch pt_id with
| None -> true
| Some(_) -> false
let edge (t: Net.Topology.t) =
let open Net.Topology in
fold_vertexes (fun v acc ->
match vertex_to_label t v with
| Net.Switch sw_id ->
PortSet.fold (vertex_to_ports t v) ~init:acc ~f:(fun acc pt_id ->
match next_hop t v pt_id with
| None -> (sw_id, pt_id)::acc
| Some _ -> acc)
| _ -> acc)
t []
module Mininet = struct
type location =
| Switch of int * int
| Host of int
let geo_sum a r n = a * ((1 - (Int.pow r n)) / (1 - r))
let (--) i j =
let rec aux n acc = if n < i then acc else aux (n-1) (n :: acc)
in aux j []
let single host_count =
let children = 1 -- host_count in
let topo_down, _ = List.fold children ~init:([], 1)
~f:(fun (acc, port) to_host ->
((Switch(1, port), Host(to_host)) :: acc), port + 1) in
let topo_up = List.map topo_down (fun (x, y) -> y, x) in
topo_up @ topo_down
let minimal = single 2
let linear switch_count =
let hosts = List.map (1 -- switch_count) (fun x -> (Switch(x, 1), Host(x))) in
let switches =
if switch_count > 1 then
(Switch(2, 2), Switch(1, 2)) :: List.map (2 -- (switch_count - 1)) (fun x -> (Switch((x + 1), 2), Switch(x, 3)))
else
[] in
let topo_down = hosts @ switches in
let topo_up = List.map topo_down (fun (x, y) -> y, x) in
topo_up @ topo_down
let tree depth fanout =
let rec add_hosts switch fanout position =
let children = (((position - 1) * fanout) + 1) -- (position * fanout) in
let switches, top_port = List.fold children ~init:([], 1)
~f:(fun (acc, port) to_host ->
((Switch(switch, port), Host(to_host)) :: acc), port + 1)
in switches in
let rec add_switches switch fanout =
let children = (((switch - 1) * fanout) + 2) -- ((switch * fanout) + 1) in
let switches, top_port = List.fold children ~init:([], 1)
~f:(fun (acc, port) to_sw ->
((Switch(switch, port), Switch(to_sw, (fanout + 1))) :: acc), port + 1)
in switches in
let switch_numbers = 1 -- (geo_sum 1 fanout (depth - 1)) in
let switch_with_hosts = List.zip_exn
(((geo_sum 1 fanout (depth - 1)) + 1) -- (geo_sum 1 fanout depth))
(1 -- (Int.pow fanout (depth - 1))) in
let sw_links = List.fold switch_numbers ~init:[] ~f:(fun acc sw -> add_switches sw fanout @ acc) in
let topo_down = List.fold switch_with_hosts ~init:sw_links ~f:(fun acc (sw, pos) -> add_hosts sw fanout pos @ acc) in
let topo_up = List.map topo_down (fun (x, y) -> y, x) in
topo_up @ topo_down
let location_tuples_to_topology location_tuples =
let location_to_id loc = match loc with
| Switch (id, port) -> Network.Node.Switch, id
| Host id -> Network.Node.Host, id in
let locations =
List.fold location_tuples ~init:[] ~f:(fun acc (x, y) ->
location_to_id x :: location_to_id y :: acc
)
|> List.dedup_and_sort ~compare:[%compare: Network.Node.device * int]
in
let topo_with_vertexes, loc_tup_to_vertex_table = List.fold locations ~init:(Network.Net.Topology.empty (), [])
~f:(fun (old_topo, acc) loc ->
let device, id = loc in
let name, ip, mac = match device with
| Network.Node.Switch -> "s" ^ (Int.to_string id), 0l, 0L
| Network.Node.Host -> "h" ^ (Int.to_string id), Int32.(of_int_exn id + 167772160l), Int64.of_int id
| Network.Node.Middlebox -> "m" ^ (Int.to_string id), 0l, 0L in
let vertex_node = Network.Node.create name (Int64.of_int id) device ip mac in
let topo, vertex = Network.Net.Topology.add_vertex old_topo vertex_node in
(topo, (loc, vertex) :: acc)) in
let find_vertex loc = List.Assoc.find_exn loc_tup_to_vertex_table ~equal:Poly.(=)
(location_to_id loc) in
List.fold location_tuples ~init:topo_with_vertexes ~f:(fun old_topo (from_loc, to_loc) ->
let loc_to_port loc = match loc with
| Switch (id, port)-> Int32.of_int_exn port
| Host id -> 1l in
let topo, _ = Network.Net.Topology.add_edge old_topo
(find_vertex from_loc) (loc_to_port from_loc)
(Network.Link.default)
(find_vertex to_loc) (loc_to_port to_loc) in
topo)
type topo_name =
| Tree of int * int
| Linear of int
| Single of int
| Minimal
let topo_from_name name =
(match name with
| Tree (x, y) -> tree x y
| Linear x -> linear x
| Single x -> single x
| Minimal -> minimal)
|> location_tuples_to_topology
end