1
(* This file is part of Marionnet, a virtual network laboratory
2
Copyright (C) 2007, 2008 Luca Saiu
3
Copyright (C) 2009, 2010 Jean-Vincent Loddo
4
Copyright (C) 2007, 2008, 2009, 2010 Université Paris 13
6
This program is free software: you can redistribute it and/or modify
7
it under the terms of the GNU General Public License as published by
8
the Free Software Foundation, either version 2 of the License, or
9
(at your option) any later version.
11
This program is distributed in the hope that it will be useful,
12
but WITHOUT ANY WARRANTY; without even the implied warranty of
13
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
14
GNU General Public License for more details.
16
You should have received a copy of the GNU General Public License
17
along with this program. If not, see <http://www.gnu.org/licenses/>. *)
20
module Row_item = Treeview.Row_item ;;
21
module Row = Treeview.Row ;;
23
type port_row_completions = (string * (string * Row_item.t) list) list
27
~after_user_edit_callback
31
Treeview.treeview_with_a_primary_key_Name_column
33
~hide_reserved_fields:true
37
val uneditable_header = "_uneditable"
38
method get_row_uneditable = self#get_CheckBox_field (uneditable_header)
40
val type_header = "Type"
41
method get_row_type = self#get_Icon_field (type_header)
42
method set_row_type = self#set_Icon_field (type_header)
44
val mac_address_header = "MAC address"
45
method get_row_mac_address = self#get_String_field (mac_address_header)
46
method set_row_mac_address = self#set_String_field (mac_address_header)
48
val mtu_header = "MTU"
49
method get_row_mtu = self#get_String_field (mtu_header)
50
method set_row_mtu = self#set_String_field (mtu_header)
52
val ipv4_address_header = "IPv4 address"
53
method get_row_ipv4_address = self#get_String_field (ipv4_address_header)
54
method set_row_ipv4_address = self#set_String_field (ipv4_address_header)
56
val ipv4_broadcast_header = "IPv4 broadcast"
57
method get_row_ipv4_broadcast = self#get_String_field (ipv4_broadcast_header)
58
method set_row_ipv4_broadcast = self#set_String_field (ipv4_broadcast_header)
60
val ipv4_netmask_header = "IPv4 netmask"
61
method get_row_ipv4_netmask = self#get_String_field (ipv4_netmask_header)
62
method set_row_ipv4_netmask = self#set_String_field (ipv4_netmask_header)
64
val ipv6_address_header = "IPv6 address"
65
method get_row_ipv6_address = self#get_String_field (ipv6_address_header)
66
method set_row_ipv6_address = self#set_String_field (ipv6_address_header)
68
method private currently_used_mac_addresses : string list =
69
let xs = List.flatten (Forest.to_list self#get_forest) in
70
let xs = ListExtra.filter_map
72
| header, (Row_item.String s) when header=mac_address_header -> Some s
77
(List.tl xs) (* Discard the first line (header) *)
79
(** The three leftmost octects are used as the trailing part of
80
automatically-generated MAC addresses.
81
Interesting side note: we can't use four because of OCaml
82
runtime type tagging (yes, Jean: I was also surprised when I
83
discovered it, but it was made that way to support precise GC,
84
which can't rely on conservative pointer finding). *)
85
method private generate_mac_address =
86
let b0 = Random.int 256 in
87
let b1 = Random.int 256 in
88
let b2 = Random.int 256 in
89
let result = Printf.sprintf "02:04:06:%02x:%02x:%02x" b2 b1 b0 in
90
(* Try again if we generated an invalid or already allocated address: *)
91
if not (List.mem result self#currently_used_mac_addresses) then
93
Log.printf "Generated MAC address: %s\n" result;
97
Log.printf "Generated MAC address: %s already in use!\n" result;
98
self#generate_mac_address
100
(** This follows exactly the same logic as automatic MAC address generation.
101
Two octects are used for a B class network: *)
102
val next_ipv4_address_as_int =
104
method private generate_ipv4_address =
105
let ipv4_address_as_int = !next_ipv4_address_as_int in
106
next_ipv4_address_as_int := ipv4_address_as_int + 1;
110
(ipv4_address_as_int / 256)
111
(ipv4_address_as_int mod 256)
113
(* Try again if we generated an invalid address: *)
114
if Ipv4.String.is_valid_ipv4 result then
117
self#generate_ipv4_address
119
(** This follows exactly the same logic as automatic MAC address generation.
120
Two octects are used for a B class network: *)
121
val next_ipv6_address_as_int =
123
method private generate_ipv6_address =
124
let ipv6_address_as_int = !next_ipv6_address_as_int in
125
next_ipv6_address_as_int := Int64.succ ipv6_address_as_int;
129
(Int64.to_int (Int64.div ipv6_address_as_int (Int64.of_int (256 * 256))))
130
(Int64.to_int (Int64.rem ipv6_address_as_int (Int64.of_int (256 * 256))))
132
(* Try again if we generated an invalid address: *)
133
if self#is_a_valid_ipv6_address result then
136
self#generate_ipv6_address
138
method add_device ?port_row_completions device_name device_type port_no =
141
[ name_header, Row_item.String device_name;
142
type_header, Row_item.Icon device_type;
143
uneditable_header, Row_item.CheckBox true;
144
mtu_header, Row_item.String "";
145
mac_address_header, Row_item.String "";
146
ipv4_address_header, Row_item.String "";
147
ipv4_netmask_header, Row_item.String "";
148
ipv4_broadcast_header, Row_item.String "";
149
ipv6_address_header, Row_item.String "";
152
self#update_port_no ?port_row_completions device_name port_no;
153
self#collapse_row row_id;
155
method port_no_of ~device_name =
156
self#children_no_of ~parent_name:device_name
158
method private add_port ?port_row_completions device_name =
159
let device_row_id = self#unique_row_id_of_name device_name in
160
let current_port_no =
161
self#port_no_of device_name in
163
match self#get_row_type (device_row_id) with
164
| "machine" | "world_bridge" -> "machine-port"
165
| "gateway" (* retro-compatibility *) -> "machine-port"
166
| "router" -> "router-port"
167
| _ -> "other-device-port" in
169
match self#get_row_type (device_row_id) with
170
"machine" | "world_bridge" -> "eth"
171
| "gateway" (* retro-compatibility *) -> "eth"
174
let port_name = (Printf.sprintf "%s%i" port_prefix current_port_no) in
175
let port_row_standard =
176
[ name_header, Row_item.String port_name;
177
type_header, Row_item.Icon port_type; ]
179
let port_row = match port_row_completions with
180
| None -> port_row_standard
183
let port_row_specific_settings = (List.assoc port_name lst) in
184
List.append (port_row_standard) (port_row_specific_settings)
185
with Not_found -> port_row_standard)
187
ignore (self#add_row ~parent_row_id:device_row_id port_row)
189
method update_port_no ?port_row_completions device_name new_port_no =
190
let add_child_of = self#add_port ?port_row_completions in
191
self#update_children_no ~add_child_of ~parent_name:device_name new_port_no
193
(* To do: these validation methods suck. *)
194
method private is_a_valid_mac_address address =
199
(fun _ _ _ _ _ _ -> Scanf.sscanf address "%c%c:%c%c:%c%c:%c%c:%c%c:%c%c"
200
(fun _ _ _ _ _ _ _ _ _ _ _ _ -> true))
204
(* TODO: FIX IT: the validity depends on the ip and netmask (broadcast must belong the network addresses range). *)
205
method private is_a_valid_ipv4_broadcast x =
206
(* self#is_a_valid_ipv4_address x*)
207
Ipv4.String.is_valid_ipv4 x
209
method private is_a_valid_ipv6_address address =
211
(* This heuristic sucked *too* much. It's better to just accept everything. *)
215
"%x:%x:%x:%x:%x:%x:%x:%x"
216
(fun o1 o2 o3 o4 o5 o6 o7 o8 ->
217
o1 < 65536 && o2 < 65536 && o3 < 65536 && o4 < 65536 &&
218
o5 < 65536 && o6 < 65536 && o7 < 65536 && o8 < 65536)
221
method private is_a_valid_ipv6_netmask x = self#is_a_valid_ipv6_address x
222
method private is_a_valid_ipv6_broadcast x = self#is_a_valid_ipv6_address x
224
method private is_a_valid_mtu x =
228
(int_of_string x) >= 0 && (int_of_string x) < 65537
232
method get_port_data ~device_name ~port_name =
233
self#get_row_of_child ~parent_name:device_name ~child_name:port_name
235
(** Return all the non-reserved data of a given port *index* (for example
236
2 stands for "eth2" or "port2", in our usual <name, item> alist
238
(* TODO: remove it *)
239
method get_port_data_by_index ~device_name ~port_index =
240
(* First try with the "eth" prefix: *)
241
let port_name = Printf.sprintf "eth%i" port_index in
243
self#get_port_data device_name port_name
245
(* We failed. Ok, now try with the "port" prefix, before bailing out: *)
246
let port_name = Printf.sprintf "port%i" port_index in
247
self#get_port_data ~device_name ~port_name
249
(** Return a single port attribute as an item: *)
251
method get_port_attribute ~device_name ~port_name ~field =
252
let row = (self#get_port_data ~device_name ~port_name) in
253
(Row.String_field.get ~field row)
255
(** Return a single port attribute as an item: *)
256
(* TODO: remove it and remove also get_port_data_by_index *)
257
method get_port_attribute_by_index ~device_name ~port_index ~field =
258
let row = (self#get_port_data_by_index ~device_name ~port_index) in
259
(Row.String_field.get ~field row)
261
(** Update a single port attribute: *)
262
method set_port_attribute_by_index ~device_name ~port_index ~field value =
263
let port_name = Printf.sprintf "port%i" port_index in
265
self#get_complete_row_of_child
266
~parent_name:device_name
267
~child_name:port_name
269
let row_id = Row.get_id row in
270
self#set_row_field row_id field value;
272
(** Update a single port attribute of type string: *)
273
method set_port_string_attribute_by_index ~device_name ~port_index ~field value =
274
self#set_port_attribute_by_index ~device_name ~port_index ~field (Row_item.String value)
276
(** Clear the interface and set the full internal state back to its initial value: *)
279
next_ipv4_address_as_int := 1;
280
next_ipv6_address_as_int := Int64.one
282
val counters_marshaler = new Oomarshal.marshaller
284
method save ?with_forest_treatment () =
285
(* Save the forest, as usual: *)
286
super#save ?with_forest_treatment ();
287
(* ...but also save the counters used for generating fresh addresses: *)
288
let counters_file_name = (Option.extract filename#get)^"-counters" in
289
(* For forward compatibility: *)
290
let _OBSOLETE_mac_address_as_int = Random.int (256*256*256) in
291
counters_marshaler#to_file
292
(_OBSOLETE_mac_address_as_int, !next_ipv4_address_as_int, !next_ipv6_address_as_int)
296
(* Load the forest, as usual: *)
298
(* ...but also load the counters used for generating fresh addresses: *)
299
let counters_file_name = (Option.extract filename#get)^"-counters" in
300
(* _OBSOLETE_mac_address_as_int read for backward compatibility: *)
301
let _OBSOLETE_mac_address_as_int, the_next_ipv4_address_as_int, the_next_ipv6_address_as_int =
302
counters_marshaler#from_file counters_file_name in
303
next_ipv4_address_as_int := the_next_ipv4_address_as_int;
304
next_ipv6_address_as_int := the_next_ipv6_address_as_int
308
self#add_checkbox_column
309
~header:uneditable_header
311
~default:(fun () -> Row_item.CheckBox false)
316
~shown_header:(s_ "Type")
317
~strings_and_pixbufs:[
318
"machine", Initialization.Path.images^"treeview-icons/machine.xpm";
319
"router", Initialization.Path.images^"treeview-icons/router.xpm";
320
"machine-port", Initialization.Path.images^"treeview-icons/network-card.xpm";
321
"router-port", Initialization.Path.images^"treeview-icons/port.xpm";
322
"other-device-port", Initialization.Path.images^"treeview-icons/port.xpm";
326
self#add_editable_string_column
327
~header:mac_address_header
328
~shown_header:(s_ "MAC address")
329
~default:(fun () -> Row_item.String self#generate_mac_address)
330
~constraint_predicate:(fun i -> let s = Row_item.extract_String i in
331
(self#is_a_valid_mac_address s) or s = "")
334
self#add_editable_string_column
336
~default:(fun () -> Row_item.String "1500")
337
~constraint_predicate:(fun i -> let s = Row_item.extract_String i in
338
(self#is_a_valid_mtu s) or s = "")
341
self#add_editable_string_column
342
~header:ipv4_address_header
343
~shown_header:(s_ "IPv4 address")
345
if Global_options.get_autogenerate_ip_addresses () then
346
Row_item.String self#generate_ipv4_address
349
~constraint_predicate:(fun i -> let s = Row_item.extract_String i in
350
(Ipv4.String.is_valid_ipv4 s) or s = "")
353
self#add_editable_string_column
354
~header:ipv4_broadcast_header
355
~shown_header:(s_ "IPv4 broadcast")
357
if Global_options.get_autogenerate_ip_addresses () then
358
Row_item.String "10.10.255.255"
361
~constraint_predicate:(fun i -> let s = Row_item.extract_String i in
362
(self#is_a_valid_ipv4_broadcast s) or s = "")
365
self#add_editable_string_column
366
~header:ipv4_netmask_header
367
~shown_header:(s_ "IPv4 netmask")
369
if Global_options.get_autogenerate_ip_addresses () then
370
Row_item.String "255.255.0.0"
373
~constraint_predicate:(fun i -> let s = Row_item.extract_String i in
374
(Ipv4.String.is_valid_netmask s) or s = "")
377
self#add_editable_string_column
378
~header:ipv6_address_header
379
~shown_header:(s_ "IPv6 address")
381
if Global_options.get_autogenerate_ip_addresses () then
382
Row_item.String self#generate_ipv6_address
385
~constraint_predicate:(fun i -> let s = Row_item.extract_String i in
386
(self#is_a_valid_ipv6_address s) or s = "")
390
self#add_row_constraint
391
~name:(s_ "you should choose a port to define this parameter")
393
let uneditable = Row.CheckBox_field.get ~field:uneditable_header row in
395
(List.for_all (fun (name, value) ->
396
name = name_header or
397
name = type_header or
398
name = uneditable_header or
399
self#is_column_reserved name or
400
value = Row_item.String "")
403
self#add_row_constraint
404
~name:(s_ "the router first port must always have a valid configuration address")
406
let port_name = (Row.get_name row) in
407
let port_type = (Row.Icon_field.get ~field:type_header row) in
408
let address = (Row.String_field.get ~field:ipv4_address_header row) in
409
let netmask = (Row.String_field.get ~field:ipv4_netmask_header row) in
410
(port_name <> "port0") or
411
(port_type <> "router-port") or
412
((address <> "") && (netmask <> "")));
414
(* In this treeview the involved device is the parent: *)
415
self#set_after_update_callback
417
after_user_edit_callback (self#get_row_parent_name row_id));
419
(* Make internal data structures: no more columns can be added now: *)
420
self#create_store_and_view;
422
(* Setup the contextual menu: *)
423
self#set_contextual_menu_title "Network interface's configuration";
426
(** Ugly kludge to make a single global instance visible from all modules
427
linked *after* this one. Not having mutually-recursive inter-compilation-unit
428
modules is a real pain. *)
431
module The_unique_treeview = Stateful_modules.Variable (struct
433
let name = Some "treeview_ifconfig"
435
let extract = The_unique_treeview.extract
437
let make ~(window:GWindow.window) ~(hbox:GPack.box) ~after_user_edit_callback () =
438
let result = new t ~packing:(hbox#add) ~after_user_edit_callback () in
439
let () = Treeview.add_expand_and_collapse_button ~window ~hbox (result:>Treeview.t) in
440
The_unique_treeview.set result;
added
removed
treeview_ifconfig.ml
