anil.recoil.org
My working unpac repository
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 ~cloexec:true 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 addr_info = convert_address address in
66 file_name :=
67 (match addr_info with
68 | { ai_addr = ADDR_UNIX file; _} -> Some file
69 | _ -> None);
70 let sock = socket ~cloexec:true addr_info.ai_family addr_info.ai_socktype
71 addr_info.ai_protocol in
72 (try
73 bind sock addr_info.ai_addr;
74 setsockopt sock SO_REUSEADDR true;
75 listen sock 3;
76 connection := io_channel_of_descr sock;
77 Input_handling.add_file !connection (accept_connection continue);
78 connection_opened := true
79 with x -> cleanup x @@ fun () -> close sock)
80 with
81 Failure e -> prerr_endline e; raise Toplevel
82 | (Unix_error _) as err -> report_error err; raise Toplevel
83
84(* Close the socket. *)
85let close_connection () =
86 if !connection_opened then begin
87 connection_opened := false;
88 Input_handling.remove_file !connection;
89 close_io !connection;
90 match !file_name with
91 Some file ->
92 unlink file
93 | None ->
94 ()
95 end
96
97(*** Kill program. ***)
98let loaded = ref false
99
100let kill_program () =
101 Breakpoints.remove_all_breakpoints ();
102 History.empty_history ();
103 kill_all_checkpoints ();
104 loaded := false;
105 close_connection ()
106
107let ask_kill_program () =
108 if not !loaded then
109 true
110 else
111 let answer = yes_or_no "A program is being debugged already. Kill it" in
112 if answer then
113 kill_program ();
114 answer
115
116(*** Program loading and initializations. ***)
117
118let initialize_loading () =
119 if !debug_loading then begin
120 prerr_endline "Loading debugging information...";
121 Printf.fprintf Stdlib.stderr "\tProgram: [%s]\n%!" !program_name;
122 end;
123 begin try access !program_name [F_OK]
124 with Unix_error _ ->
125 prerr_endline "Program not found.";
126 raise Toplevel;
127 end;
128 Symbols.clear_symbols ();
129 Symbols.read_symbols Debugcom.main_frag !program_name;
130 let Load_path.{visible; hidden} = Load_path.get_paths () in
131 let visible = visible @ !Symbols.program_source_dirs in
132 Load_path.init ~auto_include:Compmisc.auto_include ~visible ~hidden;
133 Envaux.reset_cache ();
134 if !debug_loading then
135 prerr_endline "Opening a socket...";
136 open_connection !socket_name
137 (function () ->
138 go_to _0;
139 Symbols.set_all_events Debugcom.main_frag;
140 exit_main_loop ())
141
142(* Ensure the program is already loaded. *)
143let ensure_loaded () =
144 if not !loaded then begin
145 print_string "Loading program... ";
146 flush Stdlib.stdout;
147 if !program_name = "" then begin
148 prerr_endline "No program specified.";
149 raise Toplevel
150 end;
151 try
152 initialize_loading();
153 !launching_func ();
154 if !debug_loading then
155 prerr_endline "Waiting for connection...";
156 main_loop ();
157 loaded := true;
158 prerr_endline "done."
159 with
160 x ->
161 cleanup x kill_program
162 end