2 # old_revision [78a87d334b15645b2bb54afec96ac5d3e1e45350]
5 # from [bc697ff6c3768259b1838e5638552f448433b53a]
6 # to [81cd3139b4ac5a13091737bf47b0c2e1b62eea62]
8 ============================================================
9 *** automate.ml bc697ff6c3768259b1838e5638552f448433b53a
10 --- automate.ml 81cd3139b4ac5a13091737bf47b0c2e1b62eea62
11 *************** type output = [
15 | `SYNTAX_ERROR of string]
16 ! type chunk = command_id * int * bool * string
23 | `SYNTAX_ERROR of string]
24 ! type chunk = command_id * bool * string
28 *************** let _read_cb w conditions =
31 match Giochannel.read_chars w.out_w.w_chan w.out_sb with
33 ! if debug then log "%s cb: read %d" w.out_w.w_name read ;
34 Buffer.add_substring w.out_buffer w.out_sb 0 read ;
39 match Giochannel.read_chars w.out_w.w_chan w.out_sb with
41 ! if debug then log "%s cb: read %d" w.out_w.w_name read;
42 Buffer.add_substring w.out_buffer w.out_sb 0 read ;
45 *************** let encode_stdio cmd =
50 ! let find_four_colon b =
51 ! let to_find = ref 4 in
54 let c = Buffer.nth b !i in
59 ! let find_three_colon b =
60 ! let to_find = ref 3 in
63 let c = Buffer.nth b !i in
64 *************** let decode_stdio_chunk b =
67 let decode_stdio_chunk b =
69 ! let header_len = find_four_colon b in
70 let h = Buffer.sub b 0 header_len in
71 let c1 = String.index_from h 0 ':' in
72 let number = int_of_string (string_slice ~e:c1 h) in
73 - let code = int_of_char h.[c1 + 1] - int_of_char '0' in
74 let c2 = String.index_from h (c1 + 1) ':' in
75 ! let last = h.[c2 + 1] in
76 let c3 = String.index_from h (c2 + 1) ':' in
77 ! let c4 = String.index_from h (c3 + 1) ':' in
78 ! let len = int_of_string (string_slice ~s:(c3 + 1) ~e:c4 h) in
79 if Buffer.length b < header_len + len
83 let data = truncate_buffer b header_len len in
84 ! `CHUNK (number, code, last = 'l', data)
85 with Invalid_argument _ ->
90 let decode_stdio_chunk b =
92 ! let header_len = find_three_colon b in
93 let h = Buffer.sub b 0 header_len in
94 let c1 = String.index_from h 0 ':' in
95 let number = int_of_string (string_slice ~e:c1 h) in
96 let c2 = String.index_from h (c1 + 1) ':' in
97 ! let last = h.[c1 + 1] in
98 let c3 = String.index_from h (c2 + 1) ':' in
99 ! let len = int_of_string (string_slice ~s:(c2 + 1) ~e:c3 h) in
100 if Buffer.length b < header_len + len
104 let data = truncate_buffer b header_len len in
105 ! `CHUNK (number, last = 'l', data)
106 with Invalid_argument _ ->
109 *************** let rec out_cb p b =
114 ! | `CHUNK (nb, _, _, _) when aborted_cmd p nb ->
115 p.chunks <- List.remove_assoc nb p.chunks ;
118 ! | `CHUNK ((nb, code, false, data) as chunk) ->
119 if debug then log "decoded a chunk" ;
120 let previous_chunks =
121 try List.assoc nb p.chunks
126 ! | `CHUNK (nb, _, _) when aborted_cmd p nb ->
127 p.chunks <- List.remove_assoc nb p.chunks ;
130 ! | `CHUNK ((nb, false, data) as chunk) ->
131 if debug then log "decoded a chunk" ;
132 let previous_chunks =
133 try List.assoc nb p.chunks
134 *************** let rec out_cb p b =
136 previous_chunks := chunk :: !previous_chunks ;
139 ! | `CHUNK ((nb, code, true, data) as chunk) ->
140 if debug then log "decoded last chunk" ;
144 previous_chunks := chunk :: !previous_chunks ;
147 ! | `CHUNK ((nb, true, data) as chunk) ->
148 if debug then log "decoded last chunk" ;
151 *************** let rec out_cb p b =
153 p.callbacks <- List.remove_assoc nb p.callbacks ;
156 ! (List.map (fun (_, _, _, d) -> d) chunks) in
160 ! | 1 -> `SYNTAX_ERROR msg
162 | _ -> failwith "invalid_code in automate stdio output" in
163 ! ignore (Glib.Idle.add ~prio:0 (fun () -> cb data ; false)) ;
168 p.callbacks <- List.remove_assoc nb p.callbacks ;
171 ! (List.map (function (_, false, d) -> d | (_, true, d) -> "") chunks) in
174 ! | "0" -> `OUTPUT msg
175 ! | "1" -> `SYNTAX_ERROR msg
176 ! | "2" -> `ERROR msg
177 | _ -> failwith "invalid_code in automate stdio output" in
178 ! ignore (Glib.Idle.add ~prio:0 (fun () -> cb code ; false)) ;
182 *************** let spawn mtn db =
186 exit_cb = (fun _ -> assert false)
188 + let rec check_version buf =
189 + if String.contains buf '\n' then
190 + String.length buf >= 18 && String.sub buf 0 18 = "format-version: 2\n"
192 + match Giochannel.read_chars p.p_out.out_w.w_chan p.p_out.out_sb with
193 + | `NORMAL read -> check_version (buf ^ String.sub p.p_out.out_sb 0 read)
195 + Giochannel.shutdown p.p_out.out_w.w_chan false;
196 + Giochannel.shutdown p.p_err.out_w.w_chan false;
197 + failwith "mtn version 0.46 or above is required";
198 + | `AGAIN -> check_version buf
200 + if not (check_version "")
201 + then failwith "mtn stdio uses an unknown format-version";
202 let pid = some child.Gspawn.pid in
203 ignore (Gspawn.add_child_watch ~prio:50 pid (reap_cb p pid)) ;
204 p.p_out.out_cb <- out_cb p ;