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(* Program loading *)
18
19open Unix
20open Debugger_config
21open Parameters
22open Input_handling
23
24(*** Debugging. ***)
25
26let debug_loading = ref false
27
28(*** Load a program. ***)
29
30(* Function used for launching the program. *)
31let launching_func = ref (function () -> ())
32
33let load_program () =
34 !launching_func ();
35 main_loop ()
36
37(*** Launching functions. ***)
38
39(* Returns a command line prefix to set environment for the debuggee *)
40let get_unix_environment () =
41 let f (vname, vvalue) =
42 Printf.sprintf "%s=%s " vname (Filename.quote vvalue)
43 in
44 String.concat "" (List.map f !Debugger_config.environment)
45
46(* Notes:
47 1. This quoting is not the same as [Filename.quote] because the "set"
48 command is a shell built-in and its quoting rules are different
49 from regular commands.
50 2. Microsoft's documentation omits the double-quote from the list
51 of characters that need quoting, but that is a mistake (unquoted
52 quotes are included in the value, but they alter the quoting of
53 characters between them).
54 Reference: http://msdn.microsoft.com/en-us/library/bb490954.aspx
55 *)
56let quote_for_windows_shell s =
57 let b = Buffer.create (20 + String.length s) in
58 for i = 0 to String.length s - 1 do
59 begin match s.[i] with
60 | '<' | '>' | '|' | '&' | '^' | '\"' ->
61 Buffer.add_char b '^';
62 | _ -> ()
63 end;
64 Buffer.add_char b s.[i];
65 done;
66 Buffer.contents b
67
68(* Returns a command line prefix to set environment for the debuggee *)
69let get_win32_environment () =
70 (* Note: no space before the & or Windows will add it to the value *)
71 let f (vname, vvalue) =
72 Printf.sprintf "set %s=%s&" vname (quote_for_windows_shell vvalue)
73 in
74 String.concat "" (List.map f !Debugger_config.environment)
75
76(* A generic function for launching the program *)
77let generic_exec_unix cmdline = function () ->
78 if !debug_loading then
79 prerr_endline "Launching program...";
80 let child =
81 try
82 fork ()
83 with x ->
84 Unix_tools.report_error x;
85 raise Toplevel in
86 match child with
87 0 ->
88 begin try
89 match fork () with
90 0 -> (* Try to detach the process from the controlling terminal,
91 so that it does not receive SIGINT on ctrl-C. *)
92 begin try ignore(setsid()) with Invalid_argument _ -> () end;
93 execv shell [| shell; "-c"; cmdline() |]
94 | _ -> exit 0
95 with x ->
96 Unix_tools.report_error x;
97 exit 1
98 end
99 | _ ->
100 match wait () with
101 (_, WEXITED 0) -> ()
102 | _ -> raise Toplevel
103
104let generic_exec_win cmdline = function () ->
105 if !debug_loading then
106 prerr_endline "Launching program...";
107 try ignore(create_process "cmd.exe" [| "/C"; cmdline() |] stdin stdout stderr)
108 with x ->
109 Unix_tools.report_error x;
110 raise Toplevel
111
112let generic_exec =
113 match Sys.os_type with
114 "Win32" -> generic_exec_win
115 | _ -> generic_exec_unix
116
117(* Execute the program by calling the runtime explicitly *)
118let exec_with_runtime =
119 generic_exec
120 (function () ->
121 match Sys.os_type with
122 "Win32" ->
123 (* This would fail on a file name with spaces
124 but quoting is even worse because Unix.create_process
125 thinks each command line parameter is a file.
126 So no good solution so far *)
127 Printf.sprintf "%sset CAML_DEBUG_SOCKET=%s& %s %s %s"
128 (get_win32_environment ())
129 !socket_name
130 runtime_program
131 !program_name
132 !arguments
133 | _ ->
134 Printf.sprintf "%sCAML_DEBUG_SOCKET=%s %s %s %s"
135 (get_unix_environment ())
136 !socket_name
137 (Filename.quote runtime_program)
138 (Filename.quote !program_name)
139 !arguments)
140
141(* Execute the program directly *)
142let exec_direct =
143 generic_exec
144 (function () ->
145 match Sys.os_type with
146 "Win32" ->
147 (* See the comment above *)
148 Printf.sprintf "%sset CAML_DEBUG_SOCKET=%s& %s %s"
149 (get_win32_environment ())
150 !socket_name
151 !program_name
152 !arguments
153 | _ ->
154 Printf.sprintf "%sCAML_DEBUG_SOCKET=%s %s %s"
155 (get_unix_environment ())
156 !socket_name
157 (Filename.quote !program_name)
158 !arguments)
159
160(* Ask the user. *)
161let exec_manual =
162 function () ->
163 print_newline ();
164 print_string "Waiting for connection...";
165 print_string ("(the socket is " ^ !socket_name ^ ")");
166 print_newline ()
167
168(*** Selection of the launching function. ***)
169
170type launching_function = (unit -> unit)
171
172let loading_modes =
173 ["direct", exec_direct;
174 "runtime", exec_with_runtime;
175 "manual", exec_manual]
176
177let set_launching_function func =
178 launching_func := func
179
180(* Initialization *)
181
182let _ =
183 set_launching_function exec_direct
184
185(*** Connection. ***)
186
187let connection = ref Primitives.std_io
188let connection_opened = ref false