← Back to branch summary

~loddo/marionnet/marionnet-0.94.x

« back to all changes in this revision

Viewing changes to x.ml

  • Committer: Jean-Vincent Loddo
  • Date: 2020-03-15 22:12:45 UTC
  • Revision ID: loddo@lipn.univ-paris13.fr-20200315221245-2704cah5ces5h072
Support of TCP/IPv6 X11 forwarding for kernels without ghostification (unpatched). Marionnet launch now a double stack (IPv4 and IPv6) socat service linking the virtual machines with the host X server though their eth42 interface. Moreover, a virtual machine equipped with the new version of `marionnet-relay' will continue using the TCP/IPv4 stack for X11 forwarding if eth42 can be ghostified, otherwise it will try to use the TCP/IPv6 stack. In this case, the script remove the IPv4 address (172.23.x.y/16) in order to prevent the user (probably a student) to be confused by a machine already configured which should not be. The only annoying thing will remain the presence of this interface which for the user should not exist.

Show diffs side-by-side

added added

removed removed

Lines of Context:
x.ml
25
25
    let cmd = Printf.sprintf "DISPLAY=:%d.0 xset -q 2>/dev/null 1>/dev/null" n in
26
26
    match (Unix.system cmd) with
27
27
    | Unix.WEXITED 127 -> None (* xset probably not installed *)
28
 
    | Unix.WEXITED 0 -> 
 
28
    | Unix.WEXITED 0 ->
29
29
        let () = Log.printf1 "DISPLAY fixed to value :%d.0\n" n in
30
30
        let () = Unix.putenv "DISPLAY" (Printf.sprintf ":%d.0" n) in
31
31
        Some n
36
36
(** The syntax of $DISPLAY is: [host]:display[.screen] *)
37
37
let get_host_display_screen_from_string =
38
38
 let fail x = failwith (Printf.sprintf "Ill-formed DISPLAY string: '%s'" x) in
39
 
 fun x -> 
 
39
 fun x ->
40
40
  let split_rigth_part y =
41
41
    match (StringExtra.split ~d:'.' y) with
42
42
    | [ display; screen ] -> (display, screen)
62
62
let get_host_display_screen () =
63
63
  try
64
64
    let x = Sys.getenv "DISPLAY" in
65
 
    let x = 
66
 
      if x<>"" then x else 
 
65
    let x =
 
66
      if x<>"" then x else
67
67
      match try_to_fix_DISPLAY () with
68
68
      | None   -> raise Not_found (* It's just like it weren't defined... *)
69
69
      | Some n -> Sys.getenv "DISPLAY"
73
73
  with Not_found ->
74
74
    failwith "The environment variable DISPLAY is not defined or empty, and Marionnet requires X.\nBailing out...";;
75
75
 
76
 
(* Redefinition: *)    
 
76
(* Redefinition: *)
77
77
let get_host_display_screen () =
78
78
 try  get_host_display_screen ()
79
79
 with _ -> begin
80
 
   ignore (try_to_fix_DISPLAY ()); 
 
80
   ignore (try_to_fix_DISPLAY ());
81
81
   get_host_display_screen ()
82
82
   end
83
 
    
 
83
 
84
84
(* Global variables: *)
85
 
let host, display, screen = 
 
85
let host, display, screen =
86
86
  get_host_display_screen ()
87
87
 
88
88
 
102
102
(* Just an alias: *)
103
103
let cookie = mit_magic_cookie_1
104
104
 
105
 
let socket_file_of_index (index) = 
 
105
let socket_file_of_index (index) =
106
106
  Printf.sprintf "/tmp/.X11-unix/X%i" (index)
107
107
 
108
108
(* Useful for xnest: *)
109
109
let get_unused_local_display =
110
110
  let _last_used_local_display_index = ref 0 in
111
111
  let mutex = Mutex.create () in
112
 
  fun () -> 
 
112
  fun () ->
113
113
    Mutex.lock mutex;
114
114
    let exists pathname =
115
115
      try
150
150
   | Unix.Unix_error (Unix.ECONNREFUSED, _,_) -> false
151
151
   | _ -> false
152
152
 
153
 
type port_number = int 
 
153
type port_number = int
154
154
(* --- *)
155
155
let get_unused_local_AF_INET_port_number ?(starting_from=6000) () : port_number =
156
156
  let rec loop i =
157
157
    if is_local_AF_INET_service_open ~port:i () then loop (i+1) else i
158
158
  in
159
159
  loop (starting_from)
160
 
   
 
160
 
161
161
(* Global variables: *)
162
162
let host_addr = Unix.string_of_inet_addr ((Unix.gethostbyname host).Unix.h_addr_list.(0))
163
163
and port = 6000 + (try (int_of_string display) with _ -> 0)
189
189
   end
190
190
 
191
191
(* By default the display number for the guest is the same of the host: *)
192
 
let guest_display = ref (port - 6000) 
 
192
let guest_display = ref (port - 6000)
193
193
 
194
 
(* Try to fix problems defining at the same time the good value for `guest_display'. 
 
194
(* Try to fix problems defining at the same time the good value for `guest_display'.
195
195
   If required and possible, we will try to launch a pseudo X server running on port 6000.
196
196
   In this way, the *old* virtual machines (debian-lenny, pinocchio, ...) which suppose
197
197
   DISPLAY=172.23.0.254:0 will to be able to connect to the host X server.
198
198
   Instead, new machines will be able even when guest_display<>0.
199
199
*)
200
200
let fix_X_problems : unit =
201
 
  (* --- *)    
 
201
  (* --- *)
202
202
  let socketfile = Printf.sprintf "/tmp/.X11-unix/X%s" display in
203
203
  let socketfile_exists = Sys.file_exists socketfile in
204
 
  (* --- *)    
 
204
  (* --- *)
205
205
  let no_fork = None (* Yes fork, i.e. create a process for each connection *) in
206
206
  (* let no_fork = Some () (* use Marionnet's threads *) in *)
207
 
  (* --- *)    
 
207
  (* --- *)
208
208
  let range4 = "172.23.0.0/24" in
209
 
  (* --- *)    
210
 
  let warning (available_port) (case) = 
 
209
  let range6 = "fe80::/64" in
 
210
  (* --- *)
 
211
  let warning (available_port) (case) =
211
212
    if available_port <> 6000 then
212
213
      match mit_magic_cookie_1 with
213
 
      (*--- *)      
214
 
      | None -> 
 
214
      (*--- *)
 
215
      | None ->
215
216
          Log.printf3
216
 
            "%s WARNING: to enable X on old virtual machines set: DISPLAY=172.23.0.254:%d.%s\n" 
 
217
            "%s WARNING: to enable X on old virtual machines set: DISPLAY=172.23.0.254:%d.%s\n"
217
218
            case (!guest_display) (screen)
218
 
      (*--- *)      
 
219
      (*--- *)
219
220
      | Some mit_magic_cookie_1 ->
220
 
          Log.printf5 
221
 
            "%s WARNING: to enable X on old virtual machines set:\n---\nDISPLAY=172.23.0.254:%d.%s\nxauth add 172.23.0.254:%d . %s\n---\n" 
 
221
          Log.printf5
 
222
            "%s WARNING: to enable X on old virtual machines set:\n---\nDISPLAY=172.23.0.254:%d.%s\nxauth add 172.23.0.254:%d . %s\n---\n"
222
223
            case (!guest_display) (screen) (!guest_display) (mit_magic_cookie_1)
223
224
  in
224
 
  (* --- *)    
 
225
  (* --- *)
225
226
  match is_X_server_listening_TCP_connections, host_addr with
226
227
 
227
228
  (* Case n°1: an X server runs on localhost:0 and accepts TCP connection: *)
231
232
  (* Case n°2: an X server runs on localhost and accepts TCP connection,
232
233
      but on a display Y<>0. We morally set up a PAT (Port Address Translation)
233
234
      172.23.0.254:6000 -> 127.0.0.1:(6000+Y) simply using the unix socket.
234
 
      If 6000 is busy by another process (X server), we will find a free port number. 
235
 
      Supposing 6042 be the first port number free after 6000, the PAT will be: 
 
235
      If 6000 is busy by another process (X server), we will find a free port number.
 
236
      Supposing 6042 be the first port number free after 6000, the PAT will be:
236
237
      172.23.0.254:6042 -> 127.0.0.1:(6000+Y) and guest_display=42  *)
237
238
  | true,  "127.0.0.1" when port<>6000 && socketfile_exists ->
238
239
      (* Equivalent to: socat TCP-LISTEN:6000,fork,reuseaddr UNIX-CONNECT:/tmp/.X11-unix/X? *)
241
242
      let () = Log.printf2 "(case 2) Starting a socat service: 0.0.0.0:%d -> %s\n" available_port socketfile in
242
243
      let () = warning (available_port) "(case 2)" in
243
244
      (* --- *)
244
 
      ignore_but_notify 
245
 
        ~do_not_fail:() 
246
 
        (Network.Socat.inet4_of_unix_stream_server ?no_fork ~range4 ~port:available_port ~socketfile) ()
 
245
      ignore_but_notify
 
246
        ~do_not_fail:()
 
247
        (Network.Socat.inet_of_unix_stream_server ?no_fork ~range4 ~range6 ~port:available_port ~socketfile) ()
247
248
 
248
249
  (* Case n°3: an X server seems to run on localhost accepting TCP connection,
249
250
      but the display is Y<>0 and there isn't a corresponding unix socket.
259
260
      let () = Log.printf3 "(case 3) Starting a socat service: 0.0.0.0:%d -> %s:%d\n" available_port host_addr port in
260
261
      let () = warning (available_port) "(case 3)" in
261
262
      (* --- *)
262
 
      ignore_but_notify 
263
 
        ~do_not_fail:() 
264
 
        (Network.Socat.inet4_of_inet_stream_server ?no_fork ~range4 ~port:available_port ~ipv4_or_v6:host_addr ~dport:port) ()
 
263
      ignore_but_notify
 
264
        ~do_not_fail:()
 
265
        (Network.Socat.inet_of_inet_stream_server ?no_fork ~range4 ~range6 ~port:available_port ~ipv4_or_v6:host_addr ~dport:port) ()
265
266
 
266
267
  (* Case n°4: probably a telnet or a ssh -X connection.
267
268
      Idem: the following command doesn't solve completely the problem: we have also to
272
273
      let () = guest_display := (available_port - 6000) in
273
274
      Log.printf3 "(case 4) Starting a socat service: 0.0.0.0:%d -> %s:%d\n" available_port host_addr port;
274
275
      let () = warning (available_port) "(case 4)" in
275
 
      ignore_but_notify 
276
 
        ~do_not_fail:() 
277
 
        (Network.Socat.inet4_of_inet_stream_server ?no_fork ~range4 ~port:available_port ~ipv4_or_v6:host_addr ~dport:port) ()
 
276
      ignore_but_notify
 
277
        ~do_not_fail:()
 
278
        (Network.Socat.inet_of_inet_stream_server ?no_fork ~range4 ~range6 ~port:available_port ~ipv4_or_v6:host_addr ~dport:port) ()
278
279
 
279
280
  (* Case n°5: an X server seems to run on localhost but it doesn't accept TCP connections.
280
281
      We simply redirect connection requests to the unix socket: *)
284
285
      let () = guest_display := (available_port - 6000) in
285
286
      Log.printf2 "(case 5) Starting a socat service: 0.0.0.0:%d -> %s\n" available_port socketfile;
286
287
      let () = warning (available_port) "(case 5)" in
287
 
      ignore_but_notify 
 
288
      ignore_but_notify
288
289
        ~do_not_fail:()
289
 
        (Network.Socat.inet4_of_unix_stream_server ?no_fork ~range4 ~port:available_port ~socketfile) ()
 
290
          (Network.Socat.inet_of_unix_stream_server ?no_fork ~range4 ~range6 ~port:available_port ~socketfile) ()
290
291
 
291
292
  | false, _ ->
292
293
      Log.printf "(case 6) Warning: X connections are not available for virtual machines.\n"
305
306
end (* Settings_at_loading_time *)
306
307
(* ------------------------------------------*)
307
308
 
308
 
let guest_display = 
 
309
let guest_display =
309
310
  string_of_int (!(Settings_at_loading_time.guest_display))
310
 
  
311
 
let guest_display_dot_screen = 
 
311
 
 
312
let guest_display_dot_screen =
312
313
  Printf.sprintf "%s.%s" (guest_display) (screen)