1(**************************************************************************)
2(*                                                                        *)
3(*                                 OCaml                                  *)
4(*                                                                        *)
5(*           Jerome Vouillon, projet Cristal, INRIA Rocquencourt          *)
6(*           OCaml port by John Malecki and Xavier Leroy                  *)
7(*                                                                        *)
8(*   Copyright 1996 Institut National de Recherche en Informatique et     *)
9(*     en Automatique.                                                    *)
10(*                                                                        *)
11(*   All rights reserved.  This file is distributed under the terms of    *)
12(*   the GNU Lesser General Public License version 2.1, with the          *)
13(*   special exception on linking described in the file LICENSE.          *)
14(*                                                                        *)
15(**************************************************************************)
16
17(* Manage the loading of the program *)
18
19open Int64ops
20open Unix
21open Unix_tools
22open Debugger_config
23open Primitives
24open Parameters
25open Input_handling
26open Question
27open Program_loading
28open Time_travel
29
30(*** Connection opening and control. ***)
31
32(* Name of the file if the socket is in the unix domain.*)
33let file_name = ref (None : string option)
34
35(* Default connection handler. *)
36let buffer = Bytes.create 1024
37let control_connection pid fd =
38  if (read fd.io_fd buffer 0 1024) = 0 then
39    forget_process fd pid
40  else begin
41    prerr_string "Garbage data from process ";
42    prerr_int pid;
43    prerr_endline ""
44    end
45
46(* Accept a connection from another process. *)
47let accept_connection continue fd =
48  let (sock, _) = accept fd.io_fd in
49  let io_chan = io_channel_of_descr sock in
50  let pid = input_binary_int io_chan.io_in in
51  if pid = -1 then begin
52    let pid' = input_binary_int io_chan.io_in in
53    new_checkpoint pid' io_chan;
54    Input_handling.add_file io_chan (control_connection pid');
55    continue ()
56    end
57  else begin
58    if set_file_descriptor pid io_chan then
59      Input_handling.add_file io_chan (control_connection pid)
60    end
61
62(* Initialize the socket. *)
63let open_connection address continue =
64  try
65    let (sock_domain, sock_address) = convert_address address in
66      file_name :=
67        (match sock_address with
68           ADDR_UNIX file ->
69             Some file
70         | _ ->
71             None);
72      let sock = socket sock_domain SOCK_STREAM 0 in
73        (try
74           bind sock sock_address;
75           setsockopt sock SO_REUSEADDR true;
76           listen sock 3;
77           connection := io_channel_of_descr sock;
78           Input_handling.add_file !connection (accept_connection continue);
79           connection_opened := true
80         with x -> close sock; raise x)
81  with
82    Failure _ -> raise Toplevel
83  | (Unix_error _) as err -> report_error err; raise Toplevel
84
85(* Close the socket. *)
86let close_connection () =
87  if !connection_opened then begin
88    connection_opened := false;
89    Input_handling.remove_file !connection;
90    close_io !connection;
91    match !file_name with
92      Some file ->
93        unlink file
94    | None ->
95        ()
96    end
97
98(*** Kill program. ***)
99let loaded = ref false
100
101let kill_program () =
102  Breakpoints.remove_all_breakpoints ();
103  History.empty_history ();
104  kill_all_checkpoints ();
105  loaded := false;
106  close_connection ()
107
108let ask_kill_program () =
109  if not !loaded then
110    true
111  else
112    let answer = yes_or_no "A program is being debugged already. Kill it" in
113      if answer then
114        kill_program ();
115      answer
116
117(*** Program loading and initializations. ***)
118
119let initialize_loading () =
120  if !debug_loading then begin
121    prerr_endline "Loading debugging information...";
122    Printf.fprintf Pervasives.stderr "\tProgram: [%s]\n%!" !program_name;
123  end;
124  begin try access !program_name [F_OK]
125  with Unix_error _ ->
126    prerr_endline "Program not found.";
127    raise Toplevel;
128  end;
129  Symbols.read_symbols !program_name;
130  Config.load_path := !Config.load_path @ !Symbols.program_source_dirs;
131  Envaux.reset_cache ();
132  if !debug_loading then
133    prerr_endline "Opening a socket...";
134  open_connection !socket_name
135    (function () ->
136      go_to _0;
137      Symbols.set_all_events();
138      exit_main_loop ())
139
140(* Ensure the program is already loaded. *)
141let ensure_loaded () =
142  if not !loaded then begin
143    print_string "Loading program... ";
144    flush Pervasives.stdout;
145    if !program_name = "" then begin
146      prerr_endline "No program specified.";
147      raise Toplevel
148    end;
149    try
150      initialize_loading();
151      !launching_func ();
152      if !debug_loading then
153        prerr_endline "Waiting for connection...";
154      main_loop ();
155      loaded := true;
156      prerr_endline "done."
157    with
158      x ->
159        kill_program();
160        raise x
161  end
162