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/>. *)
21
(* ***************************************** *
23
* ***************************************** *)
25
let user_intelligible_version, released =
26
match StrExtra.First.matchingp (Str.regexp "^[0-9]+[.][0-9]+[.][0-9]+$") Version.version with
28
(* it's a released version *)
29
(Version.version, true)
31
(* It's just the name of the branch *)
32
let str = Printf.sprintf "%s revno %s" Version.version Meta.revision in
36
(* ***************************************** *
38
* ***************************************** *)
41
Argv.register_usage_msg
42
(Printf.sprintf "Usage: %s [OPTIONS] [FILE]\nOptions:" Sys.argv.(0))
45
(* Registering options: *)
46
let option_v = Argv.register_unit_option "v" ~aliases:["-version"] ~doc:"print version and exit" () ;;
47
let option_debug = Argv.register_unit_option "-debug" ~doc:"activate messages for debugging" () ;;
48
let option_splash = Argv.register_unit_option "-splash" ~doc:"print splash message and exit" () ;;
49
let option_paths = Argv.register_unit_option "-paths" ~doc:"print paths (filesystems, kernels, ..) and exit" () ;;
50
let () = Argv.register_h_option_as_help () ;;
52
(* Registering arguments: *)
53
let optional_file_to_open =
56
(f_ "%s: expected a readable regular file containing the marionnet project (.mar)")
59
Argv.register_filename_optional_argument ~r:() ~f:() ~error_msg () ;;
61
(* Argv.parse tuning: *)
63
~no_error_location_parsing_arguments:()
64
~no_usage_on_error_parsing_arguments:()
67
(* Parse now (except if we are debugging with the toplevel): *)
69
if not (List.mem (Array.get Sys.argv 0) ["/tmp/marionnet-toplevel"; "/tmp/marionnet-utop"])
73
(* Now we may inspect the references: *)
75
let () = if !option_v = Some () then begin
76
Printf.kfprintf flush stdout "marionnet version %s\n" (user_intelligible_version);
80
let do_not_print_splash_message =
81
(!option_paths = Some ())
85
let () = if do_not_print_splash_message = false then
86
Log.printf ~v:0 ~banner:false
87
"=======================================================
90
Source revision : %s - %s
91
Ocamlbricks revision : %s - %s
93
Built in date %s on system:
97
For bug reporting, please get a launchpad account and
99
- report bugs at https://bugs.launchpad.net/marionnet
100
or do *all* the following:
101
- add yourself to the marionnet-dev team
102
- add yourself to the marionnet-dev mailing list
103
- write to marionnet-dev@lists.launchpad.net
104
=======================================================\n"
107
Meta.revision Meta.source_date
108
Meta_ocamlbricks.revision Meta_ocamlbricks.source_date
110
(StringExtra.fmt ~tab:8 ~width:40 Meta.uname)
113
(* Behaviour for option --splash *)
114
let () = if !option_splash = Some () then exit 0;;
118
(* Seed the random number generator: *)
119
Random.self_init ();;
121
(** Remember the cwd directory at startup time: *)
122
let cwd_at_startup_time =
125
(** Firstly read if the debug mode must be activated.
126
In this way the variable parsing can be monitored. *)
127
module Debug_level = struct
129
let of_bool = function
134
of_bool ((!option_debug=Some()) ||
135
(Configuration.extract_bool_variable_or ~default:false "MARIONNET_DEBUG"))
137
let current = ref default_level
138
let set x = (current := x)
139
let get () = !current
141
let are_we_debugging () = ((get ())>0)
142
let set_from_bool b = set (of_bool b)
144
(** Interpret the current state as suffix to append to shell commands. *)
146
if are_we_debugging () then "" else " >/dev/null 2>/dev/null "
150
(** Link the function used by the marionnet's and the ocamlbricks's logs with Debug_mode.get: *)
152
Log.Tuning.Set.debug_level Debug_level.get;
153
Ocamlbricks_log.Tuning.Set.debug_level Debug_level.get
157
"MARIONNET_DEBUG is %b (debug level %d)\n"
158
(Debug_level.are_we_debugging ()) (* is true iff you read the message *)
162
(* Used as continuation (~k) calling `extract_string_variable_or': *)
163
let append_slash x = x ^ "/" ;;
165
(* What is terminal that Marionnet must use to lanch a virtual host *)
166
let marionnet_terminal =
167
let default = "xterm,-T,-e" in
168
Configuration.extract_string_variable_or ~default "MARIONNET_TERMINAL" ;;
170
let router_filesystem_default_epithet =
171
let default = "default" in
172
Configuration.extract_string_variable_or ~default "MARIONNET_ROUTER_FILESYSTEM"
174
let router_kernel_default_epithet =
175
let default = "default" in
176
Configuration.extract_string_variable_or ~default "MARIONNET_ROUTER_KERNEL"
178
let machine_filesystem_default_epithet =
179
let default = "default" in
180
Configuration.extract_string_variable_or ~default "MARIONNET_MACHINE_FILESYSTEM"
182
let machine_kernel_default_epithet =
183
let default = "default" in
184
Configuration.extract_string_variable_or ~default "MARIONNET_MACHINE_KERNEL"
186
(* Path related configuration variables.
187
TODO: make it more robust and logged *)
191
let default = (Meta.prefix ^ "/share/" ^ Meta.name) in
192
Configuration.extract_string_variable_or ~k:append_slash ~default "MARIONNET_PREFIX"
195
let default = (marionnet_home^"filesystems/") in
196
Configuration.extract_string_variable_or ~k:append_slash ~default "MARIONNET_FILESYSTEMS_PATH"
199
let default = (marionnet_home^"kernels/") in
200
Configuration.extract_string_variable_or ~k:append_slash ~default "MARIONNET_KERNELS_PATH"
202
let images = marionnet_home^"images/"
203
let leds = marionnet_home^"images/leds/"
205
(* The prefix to prepend to VDE executables; this allows us to install
206
patched versions in an easy way, before our changes are integrated
207
into VDE's mainline... *)
209
Configuration.extract_string_variable_or ~default:"" "MARIONNET_VDE_PREFIX";;
211
(* User installation: *)
214
try (Sys.getenv "HOME") with Not_found ->
215
try ("/home/"^(Sys.getenv "USER")) with Not_found ->
216
try ("/home/"^(Sys.getenv "LOGNAME")) with Not_found ->
217
try (Sys.getenv "PWD") with Not_found ->
220
let user_filesystems = user_home^"/.marionnet/filesystems"
221
let user_kernels = user_home^"/.marionnet/kernels"
223
let marionnet_tmpdir : string option =
224
Configuration.get_string_variable "MARIONNET_TMPDIR"
229
(* Behaviour for option --paths *)
230
let () = if !option_paths = Some () then
232
FilenameExtra.remove_trailing_slashes_and_dots
234
let filesystems = prettify Path.filesystems in
235
let kernels = prettify Path.kernels in
236
let binaries = Filename.concat Meta.prefix "bin" in
237
let images = prettify Path.images in
238
let user_filesystems = prettify Path.user_filesystems in
239
let user_kernels = prettify Path.user_kernels in
240
let tmpdir = prettify (Option.extract_or Path.marionnet_tmpdir "") in
242
Printf.printf "filesystems : %s\n" filesystems;
243
Printf.printf "kernels : %s\n" kernels;
244
Printf.printf "binaries : %s\n" binaries;
245
Printf.printf "images : %s\n" images;
246
Printf.printf "user-filesystems : %s\n" user_filesystems;
247
Printf.printf "user-kernels : %s\n" user_kernels;
248
Printf.printf "tmpdir : %s\n" tmpdir;
252
(* Warnings related configuration variables. *)
253
module Disable_warnings = struct
255
let temporary_working_directory_automatically_set =
256
Configuration.extract_bool_variable_or
258
"MARIONNET_DISABLE_WARNING_TEMPORARY_WORKING_DIRECTORY_AUTOMATICALLY_SET"
262
(* Default for the factory-set configuration address for routers.
263
The result is a couple (ip,nm) where ip is the 4-tuple IPv4 and nm is the CIDR netmask. *)
264
let router_port0_default_ipv4_config =
265
let variable_name = "MARIONNET_ROUTER_PORT0_DEFAULT_IPV4_CONFIG" in
266
let default = "192.168.1.254/24" in
267
let value = Configuration.extract_string_variable_or ~default variable_name in
268
let parse arg = Ipv4.config_of_string arg in
271
Log.printf ~force:true "Warning: ill-formed value for %s\n" variable_name;
276
let keep_all_snapshots_when_saving =
277
Configuration.extract_bool_variable_or
279
"MARIONNET_KEEP_ALL_SNAPSHOTS_WHEN_SAVING"
281
(* Enter the right directory: *)
283
Unix.chdir Path.marionnet_home;
285
failwith ("Could not enter the directory (" ^ Path.marionnet_home ^ ")");;
added
removed
initialization.ml
