1
(* This file is part of Marionnet, a virtual network laboratory
2
Copyright (C) 2008 Luca Saiu
3
Copyright (C) 2010 Jean-Vincent Loddo
4
Copyright (C) 2008, 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
(** The Marionnet daemon is controlled by a simple command language. Messages
21
are passed as strings over sockets, which are printed from [parsed to]
22
very simple abstract syntax terms. *)
24
(** Tap names and bridge names are just strings: *)
34
(** The abstract syntax of requests, responses and parameters: *)
35
type resource_pattern =
36
| AnyTap of uid * ip_address
37
| AnySocketTap of uid * bridge_name
40
| SocketTap of tap_name * uid * bridge_name
43
| Make of resource_pattern
45
| DestroyAllMyResources
50
| SorryIThoughtYouWereDead;;
52
(** Printer: this is useful for debugging. *)
53
let rec string_of_daemon_resource resource =
56
Printf.sprintf "(tap %s)" tap_name
57
| SocketTap(tap_name, uid, bridge_name) ->
58
Printf.sprintf "(socket-tap %s %i %s)" tap_name uid bridge_name
59
let rec string_of_daemon_resource_pattern resource_pattern =
60
match resource_pattern with
61
| AnyTap(uid, ip_address) ->
62
Printf.sprintf "(any-tap %i %s)" uid ip_address
63
| AnySocketTap(uid, bridge_name) ->
64
Printf.sprintf "(any-socket-tap %i %s)" uid bridge_name
65
and string_of_daemon_request request =
69
| Make resource_pattern ->
70
Printf.sprintf "(make %s)" (string_of_daemon_resource_pattern resource_pattern)
72
Printf.sprintf "(destroy %s)" (string_of_daemon_resource resource)
73
| DestroyAllMyResources ->
74
"destroy-all-my-resources"
75
and string_of_daemon_response response =
79
| SorryIThoughtYouWereDead ->
80
"sorry-i-thought-you-were-dead"
82
Printf.sprintf "(error \"%s\")" message
84
Printf.sprintf "(created %s)" (string_of_daemon_resource resource);;
86
(** The length of all requests and responses in our protocol: *)
87
let message_length = 128;;
89
(** Return a fixed-length string of exactly message_length bytes, where the first
90
character is the given opcode, the following characters are the given parameters,
91
and the remaining characters, if any, are filled with spaces. The length of the
92
parameter is checked: *)
93
let make_fixed_length_message opcode parameter =
95
if ((String.length parameter) + 1) > message_length then begin
96
Log.printf "Warning: the parameter \"%s\" is too long. Truncating...\n" parameter;
98
String.sub parameter 0 ((String.length parameter) - 1)
101
(Printf.sprintf "%c" opcode) ^
103
(String.make (message_length - (String.length parameter) - 1) ' ');;
105
(** Request printer (this is for the actually communication language, not for
107
let print_request request =
110
make_fixed_length_message 'i' ""
111
| Make AnyTap(uid, ip_address) ->
112
make_fixed_length_message 'c' (Printf.sprintf "%i %s" uid ip_address)
113
| Make (AnySocketTap(uid, bridge_name)) ->
114
make_fixed_length_message 'g' (Printf.sprintf "%i %s" uid bridge_name)
115
| Destroy (Tap tap_name) ->
116
make_fixed_length_message 'd' tap_name
117
| Destroy (SocketTap(tap_name, uid, bridge_name)) ->
118
make_fixed_length_message 'D' (Printf.sprintf "%s %i %s" tap_name uid bridge_name)
119
| DestroyAllMyResources ->
120
make_fixed_length_message '!' "";;
122
(** Response printer (this is for the actually communication language, not for
124
let print_response response =
127
make_fixed_length_message 's' ""
129
make_fixed_length_message 'e' message
130
| Created (Tap tap_name) ->
131
make_fixed_length_message 'c' tap_name
132
| Created (SocketTap(tap_name, uid, bridge_name)) ->
133
make_fixed_length_message
135
(Printf.sprintf "%s %i %s" tap_name uid bridge_name)
136
| SorryIThoughtYouWereDead ->
137
make_fixed_length_message '!' "";;
139
let remove_trailing_spaces string =
140
let rec index_of_the_last_nonblank string index =
141
(* We return -1 if the string is completely made of spaces. This is
142
coherent with the way we use this local funcion below. *)
145
else if String.get string index = ' ' then
146
index_of_the_last_nonblank string (index - 1)
153
(1 + (index_of_the_last_nonblank string ((String.length string) - 1)));;
155
(** Return the opcode and parameter of the given message: *)
156
let split_message message =
157
assert((String.length message) = message_length);
158
let opcode = String.get message 0 in
159
let rest = String.sub message 1 (message_length - 1) in
160
let parameter = remove_trailing_spaces rest in
163
let parse_request request =
164
let (opcode, parameter) = split_message request in
169
Scanf.sscanf parameter "%i %s" (fun uid ip_address -> Make (AnyTap(uid, ip_address)))
171
Scanf.sscanf parameter "%i %s" (fun uid bridge_name -> Make (AnySocketTap(uid, bridge_name)))
173
Destroy (Tap parameter)
178
(fun tap_name uid bridge_name ->
179
Destroy (SocketTap(tap_name, uid, bridge_name)))
181
DestroyAllMyResources
183
failwith ("Could not parse the request \"" ^ request ^ "\"");;
185
let parse_response response =
186
let (opcode, parameter) = split_message response in
189
| 'e' -> Error parameter
190
| 'c' -> Created (Tap parameter)
195
(fun tap_name uid bridge_name ->
196
Created (SocketTap(tap_name, uid, bridge_name)))
197
| '!' -> SorryIThoughtYouWereDead
198
| _ -> failwith ("Could not parse the response \"" ^ response ^ "\"");;
200
(** We need to handle SIGPIPE when working with sockets, as a SIGPIPE
201
is the visible effect of an interrupted primitive at the OCaml level.
202
Not doing this leads to extremely nasty bugs, very hard to reproduce.
203
This may not the "correct" module to implement this, but in this way
204
I'm sure that every process, both Marionnet (client) and the daemon
205
(server) always handle the signal. *)
208
Log.printf "=========================\n";
209
Log.printf "I received the signal %i!\n" signal;
210
Log.printf "=========================\n";
212
(* Raise an exception instead of silently killing a process... *)
213
failwith (Printf.sprintf "got the signal %i" signal);;
214
Sys.set_signal Sys.sigpipe (Sys.Signal_handle signal_handler);;
added
removed
daemon_language.ml
