ia64/xen-unstable

view tools/debugger/pdb/server.ml @ 6552:a9873d384da4

Merge.
author adsharma@los-vmm.sc.intel.com
date Thu Aug 25 12:24:48 2005 -0700 (2005-08-25)
parents 112d44270733 fa0754a9f64f
children dfaf788ab18c
line source
1 (** server.ml
2 *
3 * PDB server main loop
4 *
5 * @author copyright (c) 2005 alex ho
6 * @see <www.cl.cam.ac.uk/netos/pdb> pervasive debugger
7 * @version 1
8 *)
10 open Unix
11 open Buffer
12 open Util
14 (**
15 * connection_t: The state for each connection.
16 * buffer & length contains bytes that have been read from the sock
17 * but not yet parsed / processed.
18 *)
19 type connection_t =
20 {
21 fd : file_descr;
22 mutable buffer : string;
23 mutable length : int;
24 }
27 (**
28 * validate_checksum: Compute and compare the checksum of a string
29 * against the provided checksum using the gdb serial protocol algorithm.
30 *
31 *)
32 let validate_checksum command checksum =
33 let c0 = ref 0 in
34 for loop = 0 to (String.length command - 1) do
35 c0 := !c0 + int_of_char(command.[loop]);
36 done;
37 if (String.length checksum) = 2
38 then
39 let c1 = Util.int_of_hexchar(checksum.[1]) +
40 Util.int_of_hexchar(checksum.[0]) * 16 in
41 (!c0 mod 256) = (c1 mod 256)
42 else
43 false
46 (**
47 * process_input: Oh, joy! Someone sent us a message. Let's open the
48 * envelope and see what they have to say.
49 *
50 * This function is a paradigm of inefficiency; it performs as many
51 * string copies as possible.
52 *)
53 let process_input conn sock =
54 let max_buffer_size = 1024 in
55 let in_string = String.create max_buffer_size in
57 let length = read sock in_string 0 max_buffer_size in
58 conn.buffer <- conn.buffer ^ (String.sub in_string 0 length);
59 conn.length <- conn.length + length;
60 let re = Str.regexp "[^\\$]*\\$\\([^#]*\\)#\\(..\\)" in
62 (* interrupt the target if there was a ctrl-c *)
63 begin
64 try
65 let break = String.index conn.buffer '\003' + 1 in
66 print_endline (Printf.sprintf "{{%s}}" (String.escaped conn.buffer));
68 (* discard everything seen before the ctrl-c *)
69 conn.buffer <- String.sub conn.buffer break (conn.length - break);
70 conn.length <- conn.length - break;
72 (* pause the target *)
73 PDB.pause (PDB.find_context sock);
75 (* send a code back to the debugger *)
76 Util.send_reply sock "S05"
78 with
79 Not_found -> ()
80 end;
82 (* with gdb this is unlikely to loop since you ack each packet *)
83 while ( Str.string_match re conn.buffer 0 ) do
84 let command = Str.matched_group 1 conn.buffer in
85 let checksum = Str.matched_group 2 conn.buffer in
86 let match_end = Str.group_end 2 in
88 begin
89 match validate_checksum command checksum with
90 | true ->
91 begin
92 Util.write_character sock '+';
93 try
94 let reply = Debugger.process_command command sock in
95 print_endline (Printf.sprintf "[%s] %s -> \"%s\""
96 (Util.get_connection_info sock)
97 (String.escaped command)
98 (String.escaped reply));
99 Util.send_reply sock reply
100 with
101 Util.No_reply ->
102 print_endline (Printf.sprintf "[%s] %s -> null"
103 (Util.get_connection_info sock)
104 (String.escaped command))
105 end
106 | false ->
107 Util.write_character sock '-';
108 end;
110 conn.buffer <- String.sub conn.buffer match_end (conn.length - match_end);
111 conn.length <- conn.length - match_end;
112 done;
113 if length = 0 then raise End_of_file
117 (** main_server_loop.
118 *
119 * connection_hash is a hash (duh!) with one connection_t for each
120 * open connection.
121 *
122 * in_list is a list of active sockets. it also contains a number
123 * of magic entries:
124 * - server_sock for accepting new client connections (e.g. gdb)
125 * - xen_virq_sock for Xen virq asynchronous notifications (via evtchn).
126 * This is used by context = domain
127 * - xcs_sock for xcs messages when a new backend domain registers
128 * This is used by context = process
129 *)
130 let main_server_loop sockaddr =
131 let connection_hash = Hashtbl.create 10
132 in
133 let process_socket svr_sock sockets sock =
134 let (new_list, closed_list) = sockets in
135 if sock == svr_sock
136 then
137 begin
138 let (new_sock, caller) = accept sock in
139 print_endline (Printf.sprintf "[%s] new connection from %s"
140 (Util.get_connection_info sock)
141 (Util.get_connection_info new_sock));
142 Hashtbl.add connection_hash new_sock
143 {fd=new_sock; buffer=""; length = 0};
144 PDB.add_default_context new_sock;
145 (new_sock :: new_list, closed_list)
146 end
147 else
148 begin
149 try
150 match PDB.find_context sock with
151 | PDB.Xen_virq ->
152 print_endline (Printf.sprintf "[%s] Xen virq"
153 (Util.get_connection_info sock));
154 Debugger.process_xen_virq sock;
155 (new_list, closed_list)
156 | PDB.Xen_xcs ->
157 print_endline (Printf.sprintf "[%s] Xen xcs"
158 (Util.get_connection_info sock));
159 let new_xen_domain = Debugger.process_xen_xcs sock in
160 (new_xen_domain :: new_list, closed_list)
161 | PDB.Xen_domain d ->
162 print_endline (Printf.sprintf "[%s] Xen domain"
163 (Util.get_connection_info sock));
164 Debugger.process_xen_domain sock;
165 (new_list, closed_list)
166 | _ ->
167 let conn = Hashtbl.find connection_hash sock in
168 process_input conn sock;
169 (new_list, closed_list)
170 with
171 | Not_found ->
172 print_endline "error: (main_svr_loop) context not found";
173 PDB.debug_contexts ();
174 raise Not_found
175 | End_of_file ->
176 print_endline (Printf.sprintf "[%s] close connection from %s"
177 (Util.get_connection_info sock)
178 (Util.get_connection_info sock));
179 PDB.delete_context sock;
180 Hashtbl.remove connection_hash sock;
181 close sock;
182 (new_list, sock :: closed_list)
183 end
184 in
186 let rec helper in_list server_sock =
188 (*
189 List.iter (fun x->Printf.printf " {%s}\n"
190 (Util.get_connection_info x)) in_list;
191 Printf.printf "\n";
192 *)
194 let (rd_list, _, _) = select in_list [] [] (-1.0) in
195 let (new_list, closed_list) = List.fold_left (process_socket server_sock)
196 ([],[]) rd_list in
197 let merge_list = Util.list_remove (new_list @ in_list) closed_list in
198 helper merge_list server_sock
199 in
201 try
202 let server_sock = socket (domain_of_sockaddr sockaddr) SOCK_STREAM 0 in
203 setsockopt server_sock SO_REUSEADDR true;
204 bind server_sock sockaddr;
205 listen server_sock 2;
207 PDB.open_debugger ();
208 let xen_virq_sock = Evtchn.setup () in
209 PDB.add_context xen_virq_sock "xen virq" [];
211 let xcs_sock = Xcs.setup () in
212 PDB.add_context xcs_sock "xen xcs" [];
213 helper [server_sock; xen_virq_sock; xcs_sock] server_sock
214 with
215 | Sys.Break ->
216 print_endline "break: cleaning up";
217 PDB.close_debugger ();
218 Hashtbl.iter (fun sock conn -> close sock) connection_hash
219 (* | Unix_error(e,err,param) ->
220 Printf.printf "unix error: [%s][%s][%s]\n" (error_message e) err param*)
221 | Sys_error s -> Printf.printf "sys error: [%s]\n" s
222 | Failure s -> Printf.printf "failure: [%s]\n" s
223 | End_of_file -> Printf.printf "end of file\n"
226 let get_port () =
227 if (Array.length Sys.argv) = 2
228 then
229 int_of_string Sys.argv.(1)
230 else
231 begin
232 print_endline (Printf.sprintf "error: %s <port>" Sys.argv.(0));
233 exit 1
234 end
237 let main =
238 let address = inet_addr_any in
239 let port = get_port () in
240 main_server_loop (ADDR_INET(address, port))