]>
Commit | Line | Data |
---|---|---|
83cce46b | 1 | ------------------------------------------------------------------------------ |
2 | -- -- | |
3 | -- GNAT LIBRARY COMPONENTS -- | |
4 | -- -- | |
5 | -- G N A T . E X P E C T -- | |
6 | -- -- | |
7 | -- B o d y -- | |
8 | -- -- | |
e9c75a1a | 9 | -- Copyright (C) 2000-2019, AdaCore -- |
83cce46b | 10 | -- -- |
11 | -- GNAT is free software; you can redistribute it and/or modify it under -- | |
12 | -- terms of the GNU General Public License as published by the Free Soft- -- | |
3ce44058 | 13 | -- ware Foundation; either version 3, or (at your option) any later ver- -- |
83cce46b | 14 | -- sion. GNAT is distributed in the hope that it will be useful, but WITH- -- |
15 | -- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY -- | |
3ce44058 | 16 | -- or FITNESS FOR A PARTICULAR PURPOSE. -- |
17 | -- -- | |
18 | -- As a special exception under Section 7 of GPL version 3, you are granted -- | |
19 | -- additional permissions described in the GCC Runtime Library Exception, -- | |
20 | -- version 3.1, as published by the Free Software Foundation. -- | |
21 | -- -- | |
22 | -- You should have received a copy of the GNU General Public License and -- | |
23 | -- a copy of the GCC Runtime Library Exception along with this program; -- | |
24 | -- see the files COPYING3 and COPYING.RUNTIME respectively. If not, see -- | |
25 | -- <http://www.gnu.org/licenses/>. -- | |
83cce46b | 26 | -- -- |
9dfe12ae | 27 | -- GNAT was originally developed by the GNAT team at New York University. -- |
28 | -- Extensive contributions were provided by Ada Core Technologies Inc. -- | |
83cce46b | 29 | -- -- |
30 | ------------------------------------------------------------------------------ | |
31 | ||
920e81b8 | 32 | with System; use System; |
33 | with System.OS_Constants; use System.OS_Constants; | |
34 | with Ada.Calendar; use Ada.Calendar; | |
f15731c4 | 35 | |
0baac39e | 36 | with GNAT.IO; use GNAT.IO; |
c0d15e02 | 37 | with GNAT.OS_Lib; use GNAT.OS_Lib; |
38 | with GNAT.Regpat; use GNAT.Regpat; | |
f15731c4 | 39 | |
67ee0ba6 | 40 | with Ada.Unchecked_Deallocation; |
83cce46b | 41 | |
42 | package body GNAT.Expect is | |
43 | ||
83cce46b | 44 | type Array_Of_Pd is array (Positive range <>) of Process_Descriptor_Access; |
45 | ||
c63cfa96 | 46 | Expect_Process_Died : constant Expect_Match := -100; |
47 | Expect_Internal_Error : constant Expect_Match := -101; | |
48 | -- Additional possible outputs of Expect_Internal. These are not visible in | |
49 | -- the spec because the user will never see them. | |
50 | ||
83cce46b | 51 | procedure Expect_Internal |
52 | (Descriptors : in out Array_Of_Pd; | |
53 | Result : out Expect_Match; | |
54 | Timeout : Integer; | |
55 | Full_Buffer : Boolean); | |
56 | -- Internal function used to read from the process Descriptor. | |
57 | -- | |
c63cfa96 | 58 | -- Several outputs are possible: |
83cce46b | 59 | -- Result=Expect_Timeout, if no output was available before the timeout |
60 | -- expired. | |
61 | -- Result=Expect_Full_Buffer, if Full_Buffer is True and some characters | |
62 | -- had to be discarded from the internal buffer of Descriptor. | |
c63cfa96 | 63 | -- Result=Express_Process_Died if one of the processes was terminated. |
64 | -- That process's Input_Fd is set to Invalid_FD | |
65 | -- Result=Express_Internal_Error | |
83cce46b | 66 | -- Result=<integer>, indicates how many characters were added to the |
67 | -- internal buffer. These characters are from indexes | |
68 | -- Descriptor.Buffer_Index - Result + 1 .. Descriptor.Buffer_Index | |
69 | -- Process_Died is raised if the process is no longer valid. | |
70 | ||
71 | procedure Reinitialize_Buffer | |
72 | (Descriptor : in out Process_Descriptor'Class); | |
73 | -- Reinitialize the internal buffer. | |
74 | -- The buffer is deleted up to the end of the last match. | |
75 | ||
67ee0ba6 | 76 | procedure Free is new Ada.Unchecked_Deallocation |
83cce46b | 77 | (Pattern_Matcher, Pattern_Matcher_Access); |
78 | ||
67ee0ba6 | 79 | procedure Free is new Ada.Unchecked_Deallocation |
40668b4e | 80 | (Filter_List_Elem, Filter_List); |
81 | ||
83cce46b | 82 | procedure Call_Filters |
83 | (Pid : Process_Descriptor'Class; | |
84 | Str : String; | |
85 | Filter_On : Filter_Type); | |
86 | -- Call all the filters that have the appropriate type. | |
87 | -- This function does nothing if the filters are locked | |
88 | ||
89 | ------------------------------ | |
90 | -- Target dependent section -- | |
91 | ------------------------------ | |
92 | ||
93 | function Dup (Fd : File_Descriptor) return File_Descriptor; | |
94 | pragma Import (C, Dup); | |
95 | ||
96 | procedure Dup2 (Old_Fd, New_Fd : File_Descriptor); | |
97 | pragma Import (C, Dup2); | |
98 | ||
5b91f0e7 | 99 | procedure Kill (Pid : Process_Id; Sig_Num : Integer; Close : Integer); |
9dfe12ae | 100 | pragma Import (C, Kill, "__gnat_kill"); |
5b91f0e7 | 101 | -- if Close is set to 1 all OS resources used by the Pid must be freed |
83cce46b | 102 | |
ecfefb70 | 103 | function Create_Pipe (Pipe : not null access Pipe_Type) return Integer; |
83cce46b | 104 | pragma Import (C, Create_Pipe, "__gnat_pipe"); |
105 | ||
83cce46b | 106 | function Poll |
39c5c079 | 107 | (Fds : System.Address; |
108 | Num_Fds : Integer; | |
109 | Timeout : Integer; | |
110 | Dead_Process : access Integer; | |
111 | Is_Set : System.Address) return Integer; | |
83cce46b | 112 | pragma Import (C, Poll, "__gnat_expect_poll"); |
5d373619 | 113 | -- Check whether there is any data waiting on the file descriptors |
114 | -- Fds, and wait if there is none, at most Timeout milliseconds | |
115 | -- Returns -1 in case of error, 0 if the timeout expired before | |
116 | -- data became available. | |
83cce46b | 117 | -- |
39c5c079 | 118 | -- Is_Set is an array of the same size as FDs and elements are set to 1 if |
119 | -- data is available for the corresponding File Descriptor, 0 otherwise. | |
120 | -- | |
121 | -- If a process dies, then Dead_Process is set to the index of the | |
122 | -- corresponding file descriptor. | |
83cce46b | 123 | |
f15731c4 | 124 | function Waitpid (Pid : Process_Id) return Integer; |
125 | pragma Import (C, Waitpid, "__gnat_waitpid"); | |
d72ec39e | 126 | -- Wait for a specific process id, and return its exit code |
f15731c4 | 127 | |
83cce46b | 128 | --------- |
129 | -- "+" -- | |
130 | --------- | |
131 | ||
132 | function "+" (S : String) return GNAT.OS_Lib.String_Access is | |
133 | begin | |
134 | return new String'(S); | |
135 | end "+"; | |
136 | ||
137 | --------- | |
138 | -- "+" -- | |
139 | --------- | |
140 | ||
141 | function "+" | |
67ee0ba6 | 142 | (P : GNAT.Regpat.Pattern_Matcher) return Pattern_Matcher_Access |
83cce46b | 143 | is |
144 | begin | |
145 | return new GNAT.Regpat.Pattern_Matcher'(P); | |
146 | end "+"; | |
147 | ||
148 | ---------------- | |
149 | -- Add_Filter -- | |
150 | ---------------- | |
151 | ||
152 | procedure Add_Filter | |
153 | (Descriptor : in out Process_Descriptor; | |
154 | Filter : Filter_Function; | |
155 | Filter_On : Filter_Type := Output; | |
156 | User_Data : System.Address := System.Null_Address; | |
157 | After : Boolean := False) | |
158 | is | |
159 | Current : Filter_List := Descriptor.Filters; | |
160 | ||
161 | begin | |
162 | if After then | |
163 | while Current /= null and then Current.Next /= null loop | |
164 | Current := Current.Next; | |
165 | end loop; | |
166 | ||
167 | if Current = null then | |
168 | Descriptor.Filters := | |
169 | new Filter_List_Elem' | |
f15731c4 | 170 | (Filter => Filter, Filter_On => Filter_On, |
171 | User_Data => User_Data, Next => null); | |
83cce46b | 172 | else |
173 | Current.Next := | |
174 | new Filter_List_Elem' | |
175 | (Filter => Filter, Filter_On => Filter_On, | |
176 | User_Data => User_Data, Next => null); | |
177 | end if; | |
178 | ||
179 | else | |
180 | Descriptor.Filters := | |
181 | new Filter_List_Elem' | |
182 | (Filter => Filter, Filter_On => Filter_On, | |
183 | User_Data => User_Data, Next => Descriptor.Filters); | |
184 | end if; | |
185 | end Add_Filter; | |
186 | ||
187 | ------------------ | |
188 | -- Call_Filters -- | |
189 | ------------------ | |
190 | ||
191 | procedure Call_Filters | |
192 | (Pid : Process_Descriptor'Class; | |
193 | Str : String; | |
194 | Filter_On : Filter_Type) | |
195 | is | |
196 | Current_Filter : Filter_List; | |
197 | ||
198 | begin | |
199 | if Pid.Filters_Lock = 0 then | |
200 | Current_Filter := Pid.Filters; | |
201 | ||
202 | while Current_Filter /= null loop | |
203 | if Current_Filter.Filter_On = Filter_On then | |
204 | Current_Filter.Filter | |
205 | (Pid, Str, Current_Filter.User_Data); | |
206 | end if; | |
207 | ||
208 | Current_Filter := Current_Filter.Next; | |
209 | end loop; | |
210 | end if; | |
211 | end Call_Filters; | |
212 | ||
213 | ----------- | |
214 | -- Close -- | |
215 | ----------- | |
216 | ||
f15731c4 | 217 | procedure Close |
218 | (Descriptor : in out Process_Descriptor; | |
219 | Status : out Integer) | |
220 | is | |
40668b4e | 221 | Current_Filter : Filter_List; |
222 | Next_Filter : Filter_List; | |
223 | ||
83cce46b | 224 | begin |
c63cfa96 | 225 | if Descriptor.Input_Fd /= Invalid_FD then |
226 | Close (Descriptor.Input_Fd); | |
227 | end if; | |
83cce46b | 228 | |
229 | if Descriptor.Error_Fd /= Descriptor.Output_Fd then | |
230 | Close (Descriptor.Error_Fd); | |
231 | end if; | |
232 | ||
233 | Close (Descriptor.Output_Fd); | |
234 | ||
f15731c4 | 235 | -- ??? Should have timeouts for different signals |
40668b4e | 236 | |
67ee0ba6 | 237 | if Descriptor.Pid > 0 then -- see comment in Send_Signal |
238 | Kill (Descriptor.Pid, Sig_Num => 9, Close => 0); | |
239 | end if; | |
83cce46b | 240 | |
241 | GNAT.OS_Lib.Free (Descriptor.Buffer); | |
242 | Descriptor.Buffer_Size := 0; | |
243 | ||
40668b4e | 244 | Current_Filter := Descriptor.Filters; |
245 | ||
246 | while Current_Filter /= null loop | |
247 | Next_Filter := Current_Filter.Next; | |
248 | Free (Current_Filter); | |
249 | Current_Filter := Next_Filter; | |
250 | end loop; | |
251 | ||
252 | Descriptor.Filters := null; | |
67ee0ba6 | 253 | |
254 | -- Check process id (see comment in Send_Signal) | |
255 | ||
256 | if Descriptor.Pid > 0 then | |
257 | Status := Waitpid (Descriptor.Pid); | |
258 | else | |
259 | raise Invalid_Process; | |
260 | end if; | |
f15731c4 | 261 | end Close; |
262 | ||
263 | procedure Close (Descriptor : in out Process_Descriptor) is | |
264 | Status : Integer; | |
96da3284 | 265 | pragma Unreferenced (Status); |
f15731c4 | 266 | begin |
267 | Close (Descriptor, Status); | |
83cce46b | 268 | end Close; |
269 | ||
270 | ------------ | |
271 | -- Expect -- | |
272 | ------------ | |
273 | ||
274 | procedure Expect | |
275 | (Descriptor : in out Process_Descriptor; | |
276 | Result : out Expect_Match; | |
277 | Regexp : String; | |
38b9cc41 | 278 | Timeout : Integer := 10_000; |
83cce46b | 279 | Full_Buffer : Boolean := False) |
280 | is | |
281 | begin | |
282 | if Regexp = "" then | |
283 | Expect (Descriptor, Result, Never_Match, Timeout, Full_Buffer); | |
284 | else | |
285 | Expect (Descriptor, Result, Compile (Regexp), Timeout, Full_Buffer); | |
286 | end if; | |
287 | end Expect; | |
288 | ||
289 | procedure Expect | |
290 | (Descriptor : in out Process_Descriptor; | |
291 | Result : out Expect_Match; | |
292 | Regexp : String; | |
293 | Matched : out GNAT.Regpat.Match_Array; | |
38b9cc41 | 294 | Timeout : Integer := 10_000; |
83cce46b | 295 | Full_Buffer : Boolean := False) |
296 | is | |
297 | begin | |
298 | pragma Assert (Matched'First = 0); | |
299 | if Regexp = "" then | |
300 | Expect | |
301 | (Descriptor, Result, Never_Match, Matched, Timeout, Full_Buffer); | |
302 | else | |
303 | Expect | |
304 | (Descriptor, Result, Compile (Regexp), Matched, Timeout, | |
305 | Full_Buffer); | |
306 | end if; | |
307 | end Expect; | |
308 | ||
309 | procedure Expect | |
310 | (Descriptor : in out Process_Descriptor; | |
311 | Result : out Expect_Match; | |
312 | Regexp : GNAT.Regpat.Pattern_Matcher; | |
38b9cc41 | 313 | Timeout : Integer := 10_000; |
83cce46b | 314 | Full_Buffer : Boolean := False) |
315 | is | |
316 | Matched : GNAT.Regpat.Match_Array (0 .. 0); | |
96da3284 | 317 | pragma Warnings (Off, Matched); |
83cce46b | 318 | begin |
319 | Expect (Descriptor, Result, Regexp, Matched, Timeout, Full_Buffer); | |
320 | end Expect; | |
321 | ||
322 | procedure Expect | |
323 | (Descriptor : in out Process_Descriptor; | |
324 | Result : out Expect_Match; | |
325 | Regexp : GNAT.Regpat.Pattern_Matcher; | |
326 | Matched : out GNAT.Regpat.Match_Array; | |
38b9cc41 | 327 | Timeout : Integer := 10_000; |
83cce46b | 328 | Full_Buffer : Boolean := False) |
329 | is | |
330 | N : Expect_Match; | |
331 | Descriptors : Array_Of_Pd := (1 => Descriptor'Unrestricted_Access); | |
9dfe12ae | 332 | Try_Until : constant Time := Clock + Duration (Timeout) / 1000.0; |
83cce46b | 333 | Timeout_Tmp : Integer := Timeout; |
334 | ||
335 | begin | |
336 | pragma Assert (Matched'First = 0); | |
337 | Reinitialize_Buffer (Descriptor); | |
338 | ||
339 | loop | |
340 | -- First, test if what is already in the buffer matches (This is | |
341 | -- required if this package is used in multi-task mode, since one of | |
342 | -- the tasks might have added something in the buffer, and we don't | |
343 | -- want other tasks to wait for new input to be available before | |
344 | -- checking the regexps). | |
345 | ||
346 | Match | |
347 | (Regexp, Descriptor.Buffer (1 .. Descriptor.Buffer_Index), Matched); | |
348 | ||
349 | if Descriptor.Buffer_Index >= 1 and then Matched (0).First /= 0 then | |
350 | Result := 1; | |
351 | Descriptor.Last_Match_Start := Matched (0).First; | |
352 | Descriptor.Last_Match_End := Matched (0).Last; | |
353 | return; | |
354 | end if; | |
355 | ||
356 | -- Else try to read new input | |
357 | ||
358 | Expect_Internal (Descriptors, N, Timeout_Tmp, Full_Buffer); | |
359 | ||
c63cfa96 | 360 | case N is |
99378362 | 361 | when Expect_Internal_Error |
362 | | Expect_Process_Died | |
363 | => | |
c63cfa96 | 364 | raise Process_Died; |
365 | ||
99378362 | 366 | when Expect_Full_Buffer |
367 | | Expect_Timeout | |
368 | => | |
c63cfa96 | 369 | Result := N; |
370 | return; | |
371 | ||
372 | when others => | |
373 | null; -- See below | |
374 | end case; | |
83cce46b | 375 | |
5b91f0e7 | 376 | -- Calculate the timeout for the next turn |
377 | ||
83cce46b | 378 | -- Note that Timeout is, from the caller's perspective, the maximum |
379 | -- time until a match, not the maximum time until some output is | |
5b91f0e7 | 380 | -- read, and thus cannot be reused as is for Expect_Internal. |
83cce46b | 381 | |
382 | if Timeout /= -1 then | |
383 | Timeout_Tmp := Integer (Try_Until - Clock) * 1000; | |
384 | ||
385 | if Timeout_Tmp < 0 then | |
386 | Result := Expect_Timeout; | |
387 | exit; | |
388 | end if; | |
389 | end if; | |
390 | end loop; | |
391 | ||
392 | -- Even if we had the general timeout above, we have to test that the | |
393 | -- last test we read from the external process didn't match. | |
394 | ||
395 | Match | |
396 | (Regexp, Descriptor.Buffer (1 .. Descriptor.Buffer_Index), Matched); | |
397 | ||
398 | if Matched (0).First /= 0 then | |
399 | Result := 1; | |
400 | Descriptor.Last_Match_Start := Matched (0).First; | |
401 | Descriptor.Last_Match_End := Matched (0).Last; | |
402 | return; | |
403 | end if; | |
404 | end Expect; | |
405 | ||
406 | procedure Expect | |
407 | (Descriptor : in out Process_Descriptor; | |
408 | Result : out Expect_Match; | |
409 | Regexps : Regexp_Array; | |
38b9cc41 | 410 | Timeout : Integer := 10_000; |
83cce46b | 411 | Full_Buffer : Boolean := False) |
412 | is | |
413 | Patterns : Compiled_Regexp_Array (Regexps'Range); | |
96da3284 | 414 | |
415 | Matched : GNAT.Regpat.Match_Array (0 .. 0); | |
416 | pragma Warnings (Off, Matched); | |
83cce46b | 417 | |
418 | begin | |
419 | for J in Regexps'Range loop | |
420 | Patterns (J) := new Pattern_Matcher'(Compile (Regexps (J).all)); | |
421 | end loop; | |
422 | ||
423 | Expect (Descriptor, Result, Patterns, Matched, Timeout, Full_Buffer); | |
424 | ||
425 | for J in Regexps'Range loop | |
426 | Free (Patterns (J)); | |
427 | end loop; | |
428 | end Expect; | |
429 | ||
430 | procedure Expect | |
431 | (Descriptor : in out Process_Descriptor; | |
432 | Result : out Expect_Match; | |
433 | Regexps : Compiled_Regexp_Array; | |
38b9cc41 | 434 | Timeout : Integer := 10_000; |
83cce46b | 435 | Full_Buffer : Boolean := False) |
436 | is | |
437 | Matched : GNAT.Regpat.Match_Array (0 .. 0); | |
96da3284 | 438 | pragma Warnings (Off, Matched); |
83cce46b | 439 | begin |
440 | Expect (Descriptor, Result, Regexps, Matched, Timeout, Full_Buffer); | |
441 | end Expect; | |
442 | ||
443 | procedure Expect | |
444 | (Result : out Expect_Match; | |
445 | Regexps : Multiprocess_Regexp_Array; | |
38b9cc41 | 446 | Timeout : Integer := 10_000; |
83cce46b | 447 | Full_Buffer : Boolean := False) |
448 | is | |
449 | Matched : GNAT.Regpat.Match_Array (0 .. 0); | |
96da3284 | 450 | pragma Warnings (Off, Matched); |
83cce46b | 451 | begin |
452 | Expect (Result, Regexps, Matched, Timeout, Full_Buffer); | |
453 | end Expect; | |
454 | ||
455 | procedure Expect | |
456 | (Descriptor : in out Process_Descriptor; | |
457 | Result : out Expect_Match; | |
458 | Regexps : Regexp_Array; | |
459 | Matched : out GNAT.Regpat.Match_Array; | |
38b9cc41 | 460 | Timeout : Integer := 10_000; |
83cce46b | 461 | Full_Buffer : Boolean := False) |
462 | is | |
463 | Patterns : Compiled_Regexp_Array (Regexps'Range); | |
464 | ||
465 | begin | |
466 | pragma Assert (Matched'First = 0); | |
467 | ||
468 | for J in Regexps'Range loop | |
469 | Patterns (J) := new Pattern_Matcher'(Compile (Regexps (J).all)); | |
470 | end loop; | |
471 | ||
472 | Expect (Descriptor, Result, Patterns, Matched, Timeout, Full_Buffer); | |
473 | ||
474 | for J in Regexps'Range loop | |
475 | Free (Patterns (J)); | |
476 | end loop; | |
477 | end Expect; | |
478 | ||
479 | procedure Expect | |
480 | (Descriptor : in out Process_Descriptor; | |
481 | Result : out Expect_Match; | |
482 | Regexps : Compiled_Regexp_Array; | |
483 | Matched : out GNAT.Regpat.Match_Array; | |
38b9cc41 | 484 | Timeout : Integer := 10_000; |
83cce46b | 485 | Full_Buffer : Boolean := False) |
486 | is | |
487 | N : Expect_Match; | |
488 | Descriptors : Array_Of_Pd := (1 => Descriptor'Unrestricted_Access); | |
489 | ||
490 | begin | |
491 | pragma Assert (Matched'First = 0); | |
492 | ||
493 | Reinitialize_Buffer (Descriptor); | |
494 | ||
495 | loop | |
496 | -- First, test if what is already in the buffer matches (This is | |
497 | -- required if this package is used in multi-task mode, since one of | |
498 | -- the tasks might have added something in the buffer, and we don't | |
499 | -- want other tasks to wait for new input to be available before | |
500 | -- checking the regexps). | |
501 | ||
502 | if Descriptor.Buffer /= null then | |
503 | for J in Regexps'Range loop | |
504 | Match | |
505 | (Regexps (J).all, | |
506 | Descriptor.Buffer (1 .. Descriptor.Buffer_Index), | |
507 | Matched); | |
508 | ||
509 | if Matched (0) /= No_Match then | |
510 | Result := Expect_Match (J); | |
511 | Descriptor.Last_Match_Start := Matched (0).First; | |
512 | Descriptor.Last_Match_End := Matched (0).Last; | |
513 | return; | |
514 | end if; | |
515 | end loop; | |
516 | end if; | |
517 | ||
518 | Expect_Internal (Descriptors, N, Timeout, Full_Buffer); | |
519 | ||
c63cfa96 | 520 | case N is |
99378362 | 521 | when Expect_Internal_Error |
522 | | Expect_Process_Died | |
523 | => | |
c63cfa96 | 524 | raise Process_Died; |
525 | ||
99378362 | 526 | when Expect_Full_Buffer |
527 | | Expect_Timeout | |
528 | => | |
c63cfa96 | 529 | Result := N; |
530 | return; | |
531 | ||
532 | when others => | |
533 | null; -- Continue | |
534 | end case; | |
83cce46b | 535 | end loop; |
536 | end Expect; | |
537 | ||
538 | procedure Expect | |
539 | (Result : out Expect_Match; | |
540 | Regexps : Multiprocess_Regexp_Array; | |
541 | Matched : out GNAT.Regpat.Match_Array; | |
38b9cc41 | 542 | Timeout : Integer := 10_000; |
83cce46b | 543 | Full_Buffer : Boolean := False) |
544 | is | |
545 | N : Expect_Match; | |
546 | Descriptors : Array_Of_Pd (Regexps'Range); | |
547 | ||
548 | begin | |
549 | pragma Assert (Matched'First = 0); | |
550 | ||
551 | for J in Descriptors'Range loop | |
552 | Descriptors (J) := Regexps (J).Descriptor; | |
2f765379 | 553 | |
c63cfa96 | 554 | if Descriptors (J) /= null then |
555 | Reinitialize_Buffer (Regexps (J).Descriptor.all); | |
556 | end if; | |
83cce46b | 557 | end loop; |
558 | ||
559 | loop | |
560 | -- First, test if what is already in the buffer matches (This is | |
561 | -- required if this package is used in multi-task mode, since one of | |
562 | -- the tasks might have added something in the buffer, and we don't | |
563 | -- want other tasks to wait for new input to be available before | |
564 | -- checking the regexps). | |
565 | ||
566 | for J in Regexps'Range loop | |
c63cfa96 | 567 | if Regexps (J).Regexp /= null |
568 | and then Regexps (J).Descriptor /= null | |
569 | then | |
570 | Match (Regexps (J).Regexp.all, | |
571 | Regexps (J).Descriptor.Buffer | |
572 | (1 .. Regexps (J).Descriptor.Buffer_Index), | |
573 | Matched); | |
574 | ||
575 | if Matched (0) /= No_Match then | |
576 | Result := Expect_Match (J); | |
577 | Regexps (J).Descriptor.Last_Match_Start := Matched (0).First; | |
578 | Regexps (J).Descriptor.Last_Match_End := Matched (0).Last; | |
579 | return; | |
580 | end if; | |
83cce46b | 581 | end if; |
582 | end loop; | |
583 | ||
584 | Expect_Internal (Descriptors, N, Timeout, Full_Buffer); | |
585 | ||
c63cfa96 | 586 | case N is |
99378362 | 587 | when Expect_Internal_Error |
588 | | Expect_Process_Died | |
589 | => | |
c63cfa96 | 590 | raise Process_Died; |
591 | ||
99378362 | 592 | when Expect_Full_Buffer |
593 | | Expect_Timeout | |
594 | => | |
c63cfa96 | 595 | Result := N; |
596 | return; | |
597 | ||
598 | when others => | |
599 | null; -- Continue | |
600 | end case; | |
83cce46b | 601 | end loop; |
602 | end Expect; | |
603 | ||
604 | --------------------- | |
605 | -- Expect_Internal -- | |
606 | --------------------- | |
607 | ||
608 | procedure Expect_Internal | |
609 | (Descriptors : in out Array_Of_Pd; | |
610 | Result : out Expect_Match; | |
611 | Timeout : Integer; | |
612 | Full_Buffer : Boolean) | |
613 | is | |
614 | Num_Descriptors : Integer; | |
615 | Buffer_Size : Integer := 0; | |
616 | ||
f15731c4 | 617 | N : Integer; |
83cce46b | 618 | |
619 | type File_Descriptor_Array is | |
c63cfa96 | 620 | array (0 .. Descriptors'Length - 1) of File_Descriptor; |
83cce46b | 621 | Fds : aliased File_Descriptor_Array; |
c63cfa96 | 622 | Fds_Count : Natural := 0; |
83cce46b | 623 | |
c63cfa96 | 624 | Fds_To_Descriptor : array (Fds'Range) of Integer; |
625 | -- Maps file descriptor entries from Fds to entries in Descriptors. | |
626 | -- They do not have the same index when entries in Descriptors are null. | |
627 | ||
628 | type Integer_Array is array (Fds'Range) of Integer; | |
83cce46b | 629 | Is_Set : aliased Integer_Array; |
630 | ||
631 | begin | |
632 | for J in Descriptors'Range loop | |
c63cfa96 | 633 | if Descriptors (J) /= null then |
634 | Fds (Fds'First + Fds_Count) := Descriptors (J).Output_Fd; | |
635 | Fds_To_Descriptor (Fds'First + Fds_Count) := J; | |
636 | Fds_Count := Fds_Count + 1; | |
83cce46b | 637 | |
c63cfa96 | 638 | if Descriptors (J).Buffer_Size = 0 then |
639 | Buffer_Size := Integer'Max (Buffer_Size, 4096); | |
640 | else | |
641 | Buffer_Size := | |
642 | Integer'Max (Buffer_Size, Descriptors (J).Buffer_Size); | |
643 | end if; | |
83cce46b | 644 | end if; |
645 | end loop; | |
646 | ||
647 | declare | |
648 | Buffer : aliased String (1 .. Buffer_Size); | |
649 | -- Buffer used for input. This is allocated only once, not for | |
650 | -- every iteration of the loop | |
651 | ||
39c5c079 | 652 | D : aliased Integer; |
c63cfa96 | 653 | -- Index in Descriptors |
654 | ||
83cce46b | 655 | begin |
656 | -- Loop until we match or we have a timeout | |
657 | ||
658 | loop | |
659 | Num_Descriptors := | |
39c5c079 | 660 | Poll (Fds'Address, Fds_Count, Timeout, D'Access, Is_Set'Address); |
83cce46b | 661 | |
662 | case Num_Descriptors is | |
663 | ||
664 | -- Error? | |
665 | ||
666 | when -1 => | |
c63cfa96 | 667 | Result := Expect_Internal_Error; |
39c5c079 | 668 | |
669 | if D /= 0 then | |
670 | Close (Descriptors (D).Input_Fd); | |
671 | Descriptors (D).Input_Fd := Invalid_FD; | |
672 | end if; | |
673 | ||
c63cfa96 | 674 | return; |
83cce46b | 675 | |
676 | -- Timeout? | |
677 | ||
678 | when 0 => | |
679 | Result := Expect_Timeout; | |
680 | return; | |
681 | ||
682 | -- Some input | |
683 | ||
684 | when others => | |
c63cfa96 | 685 | for F in Fds'Range loop |
686 | if Is_Set (F) = 1 then | |
687 | D := Fds_To_Descriptor (F); | |
688 | ||
689 | Buffer_Size := Descriptors (D).Buffer_Size; | |
83cce46b | 690 | |
691 | if Buffer_Size = 0 then | |
692 | Buffer_Size := 4096; | |
693 | end if; | |
694 | ||
ebaebbd1 | 695 | -- Read may be interrupted on Linux by a signal and |
696 | -- need to be repeated. We don't want to check for | |
697 | -- errno = EINTER, so just attempt to read a few | |
698 | -- times. | |
699 | ||
700 | for J in 1 .. 3 loop | |
701 | N := Read (Descriptors (D).Output_Fd, | |
702 | Buffer'Address, Buffer_Size); | |
703 | ||
704 | exit when N > 0; | |
705 | end loop; | |
83cce46b | 706 | |
707 | -- Error or End of file | |
708 | ||
709 | if N <= 0 then | |
0baac39e | 710 | Close (Descriptors (D).Input_Fd); |
c63cfa96 | 711 | Descriptors (D).Input_Fd := Invalid_FD; |
712 | Result := Expect_Process_Died; | |
713 | return; | |
83cce46b | 714 | |
715 | else | |
716 | -- If there is no limit to the buffer size | |
717 | ||
c63cfa96 | 718 | if Descriptors (D).Buffer_Size = 0 then |
83cce46b | 719 | declare |
c63cfa96 | 720 | Tmp : String_Access := Descriptors (D).Buffer; |
83cce46b | 721 | |
722 | begin | |
723 | if Tmp /= null then | |
c63cfa96 | 724 | Descriptors (D).Buffer := |
83cce46b | 725 | new String (1 .. Tmp'Length + N); |
c63cfa96 | 726 | Descriptors (D).Buffer (1 .. Tmp'Length) := |
83cce46b | 727 | Tmp.all; |
c63cfa96 | 728 | Descriptors (D).Buffer |
83cce46b | 729 | (Tmp'Length + 1 .. Tmp'Length + N) := |
730 | Buffer (1 .. N); | |
731 | Free (Tmp); | |
c63cfa96 | 732 | Descriptors (D).Buffer_Index := |
733 | Descriptors (D).Buffer'Last; | |
83cce46b | 734 | |
735 | else | |
c63cfa96 | 736 | Descriptors (D).Buffer := |
83cce46b | 737 | new String (1 .. N); |
c63cfa96 | 738 | Descriptors (D).Buffer.all := |
83cce46b | 739 | Buffer (1 .. N); |
c63cfa96 | 740 | Descriptors (D).Buffer_Index := N; |
83cce46b | 741 | end if; |
742 | end; | |
743 | ||
744 | else | |
745 | -- Add what we read to the buffer | |
746 | ||
c63cfa96 | 747 | if Descriptors (D).Buffer_Index + N > |
99378362 | 748 | Descriptors (D).Buffer_Size |
83cce46b | 749 | then |
750 | -- If the user wants to know when we have | |
751 | -- read more than the buffer can contain. | |
752 | ||
753 | if Full_Buffer then | |
754 | Result := Expect_Full_Buffer; | |
755 | return; | |
756 | end if; | |
757 | ||
758 | -- Keep as much as possible from the buffer, | |
759 | -- and forget old characters. | |
760 | ||
c63cfa96 | 761 | Descriptors (D).Buffer |
762 | (1 .. Descriptors (D).Buffer_Size - N) := | |
763 | Descriptors (D).Buffer | |
764 | (N - Descriptors (D).Buffer_Size + | |
765 | Descriptors (D).Buffer_Index + 1 .. | |
766 | Descriptors (D).Buffer_Index); | |
767 | Descriptors (D).Buffer_Index := | |
768 | Descriptors (D).Buffer_Size - N; | |
83cce46b | 769 | end if; |
770 | ||
d72ec39e | 771 | -- Keep what we read in the buffer |
83cce46b | 772 | |
c63cfa96 | 773 | Descriptors (D).Buffer |
774 | (Descriptors (D).Buffer_Index + 1 .. | |
775 | Descriptors (D).Buffer_Index + N) := | |
83cce46b | 776 | Buffer (1 .. N); |
c63cfa96 | 777 | Descriptors (D).Buffer_Index := |
778 | Descriptors (D).Buffer_Index + N; | |
83cce46b | 779 | end if; |
780 | ||
781 | -- Call each of the output filter with what we | |
782 | -- read. | |
783 | ||
784 | Call_Filters | |
c63cfa96 | 785 | (Descriptors (D).all, Buffer (1 .. N), Output); |
83cce46b | 786 | |
c63cfa96 | 787 | Result := Expect_Match (D); |
83cce46b | 788 | return; |
789 | end if; | |
790 | end if; | |
791 | end loop; | |
792 | end case; | |
793 | end loop; | |
794 | end; | |
795 | end Expect_Internal; | |
796 | ||
797 | ---------------- | |
798 | -- Expect_Out -- | |
799 | ---------------- | |
800 | ||
801 | function Expect_Out (Descriptor : Process_Descriptor) return String is | |
802 | begin | |
803 | return Descriptor.Buffer (1 .. Descriptor.Last_Match_End); | |
804 | end Expect_Out; | |
805 | ||
806 | ---------------------- | |
807 | -- Expect_Out_Match -- | |
808 | ---------------------- | |
809 | ||
810 | function Expect_Out_Match (Descriptor : Process_Descriptor) return String is | |
811 | begin | |
812 | return Descriptor.Buffer | |
813 | (Descriptor.Last_Match_Start .. Descriptor.Last_Match_End); | |
814 | end Expect_Out_Match; | |
815 | ||
c63cfa96 | 816 | ------------------------ |
817 | -- First_Dead_Process -- | |
818 | ------------------------ | |
819 | ||
820 | function First_Dead_Process | |
821 | (Regexp : Multiprocess_Regexp_Array) return Natural is | |
822 | begin | |
823 | for R in Regexp'Range loop | |
824 | if Regexp (R).Descriptor /= null | |
825 | and then Regexp (R).Descriptor.Input_Fd = GNAT.OS_Lib.Invalid_FD | |
826 | then | |
827 | return R; | |
828 | end if; | |
829 | end loop; | |
830 | ||
831 | return 0; | |
832 | end First_Dead_Process; | |
833 | ||
83cce46b | 834 | ----------- |
835 | -- Flush -- | |
836 | ----------- | |
837 | ||
838 | procedure Flush | |
839 | (Descriptor : in out Process_Descriptor; | |
840 | Timeout : Integer := 0) | |
841 | is | |
9dfe12ae | 842 | Buffer_Size : constant Integer := 8192; |
83cce46b | 843 | Num_Descriptors : Integer; |
39c5c079 | 844 | N : aliased Integer; |
83cce46b | 845 | Is_Set : aliased Integer; |
83cce46b | 846 | Buffer : aliased String (1 .. Buffer_Size); |
847 | ||
848 | begin | |
849 | -- Empty the current buffer | |
850 | ||
851 | Descriptor.Last_Match_End := Descriptor.Buffer_Index; | |
852 | Reinitialize_Buffer (Descriptor); | |
853 | ||
854 | -- Read everything from the process to flush its output | |
855 | ||
856 | loop | |
857 | Num_Descriptors := | |
39c5c079 | 858 | Poll (Descriptor.Output_Fd'Address, |
859 | 1, | |
860 | Timeout, | |
861 | N'Access, | |
862 | Is_Set'Address); | |
83cce46b | 863 | |
864 | case Num_Descriptors is | |
865 | ||
866 | -- Error ? | |
867 | ||
868 | when -1 => | |
869 | raise Process_Died; | |
870 | ||
871 | -- Timeout => End of flush | |
872 | ||
873 | when 0 => | |
874 | return; | |
875 | ||
876 | -- Some input | |
877 | ||
878 | when others => | |
879 | if Is_Set = 1 then | |
880 | N := Read (Descriptor.Output_Fd, Buffer'Address, | |
881 | Buffer_Size); | |
882 | ||
883 | if N = -1 then | |
884 | raise Process_Died; | |
885 | elsif N = 0 then | |
886 | return; | |
887 | end if; | |
888 | end if; | |
889 | end case; | |
890 | end loop; | |
83cce46b | 891 | end Flush; |
892 | ||
c63cfa96 | 893 | ---------- |
894 | -- Free -- | |
895 | ---------- | |
896 | ||
897 | procedure Free (Regexp : in out Multiprocess_Regexp) is | |
898 | procedure Unchecked_Free is new Ada.Unchecked_Deallocation | |
899 | (Process_Descriptor'Class, Process_Descriptor_Access); | |
900 | begin | |
901 | Unchecked_Free (Regexp.Descriptor); | |
902 | Free (Regexp.Regexp); | |
903 | end Free; | |
904 | ||
d72ec39e | 905 | ------------------------ |
906 | -- Get_Command_Output -- | |
907 | ------------------------ | |
908 | ||
909 | function Get_Command_Output | |
910 | (Command : String; | |
911 | Arguments : GNAT.OS_Lib.Argument_List; | |
912 | Input : String; | |
ecfefb70 | 913 | Status : not null access Integer; |
d72ec39e | 914 | Err_To_Out : Boolean := False) return String |
915 | is | |
d72ec39e | 916 | Process : Process_Descriptor; |
917 | ||
918 | Output : String_Access := new String (1 .. 1024); | |
919 | -- Buffer used to accumulate standard output from the launched | |
920 | -- command, expanded as necessary during execution. | |
921 | ||
922 | Last : Integer := 0; | |
923 | -- Index of the last used character within Output | |
924 | ||
925 | begin | |
926 | Non_Blocking_Spawn | |
0baac39e | 927 | (Process, Command, Arguments, Err_To_Out => Err_To_Out, |
928 | Buffer_Size => 0); | |
d72ec39e | 929 | |
930 | if Input'Length > 0 then | |
931 | Send (Process, Input); | |
932 | end if; | |
933 | ||
fd66bc6b | 934 | Close (Process.Input_Fd); |
935 | Process.Input_Fd := Invalid_FD; | |
d72ec39e | 936 | |
937 | declare | |
938 | Result : Expect_Match; | |
96da3284 | 939 | pragma Unreferenced (Result); |
d72ec39e | 940 | |
941 | begin | |
942 | -- This loop runs until the call to Expect raises Process_Died | |
943 | ||
944 | loop | |
f0ca294b | 945 | Expect (Process, Result, ".+", Timeout => -1); |
d72ec39e | 946 | |
947 | declare | |
948 | NOutput : String_Access; | |
949 | S : constant String := Expect_Out (Process); | |
950 | pragma Assert (S'Length > 0); | |
951 | ||
952 | begin | |
ecfefb70 | 953 | -- Expand buffer if we need more space. Note here that we add |
954 | -- S'Length to ensure that S will fit in the new buffer size. | |
d72ec39e | 955 | |
956 | if Last + S'Length > Output'Last then | |
ecfefb70 | 957 | NOutput := new String (1 .. 2 * Output'Last + S'Length); |
d72ec39e | 958 | NOutput (Output'Range) := Output.all; |
959 | Free (Output); | |
960 | ||
844982ae | 961 | -- Here if current buffer size is OK |
d72ec39e | 962 | |
963 | else | |
964 | NOutput := Output; | |
965 | end if; | |
966 | ||
967 | NOutput (Last + 1 .. Last + S'Length) := S; | |
968 | Last := Last + S'Length; | |
969 | Output := NOutput; | |
970 | end; | |
971 | end loop; | |
972 | ||
973 | exception | |
974 | when Process_Died => | |
975 | Close (Process, Status.all); | |
976 | end; | |
977 | ||
978 | if Last = 0 then | |
4acfc61e | 979 | Free (Output); |
d72ec39e | 980 | return ""; |
981 | end if; | |
982 | ||
983 | declare | |
984 | S : constant String := Output (1 .. Last); | |
985 | begin | |
986 | Free (Output); | |
987 | return S; | |
988 | end; | |
989 | end Get_Command_Output; | |
990 | ||
83cce46b | 991 | ------------------ |
992 | -- Get_Error_Fd -- | |
993 | ------------------ | |
994 | ||
995 | function Get_Error_Fd | |
67ee0ba6 | 996 | (Descriptor : Process_Descriptor) return GNAT.OS_Lib.File_Descriptor |
997 | is | |
83cce46b | 998 | begin |
999 | return Descriptor.Error_Fd; | |
1000 | end Get_Error_Fd; | |
1001 | ||
1002 | ------------------ | |
1003 | -- Get_Input_Fd -- | |
1004 | ------------------ | |
1005 | ||
1006 | function Get_Input_Fd | |
67ee0ba6 | 1007 | (Descriptor : Process_Descriptor) return GNAT.OS_Lib.File_Descriptor |
1008 | is | |
83cce46b | 1009 | begin |
1010 | return Descriptor.Input_Fd; | |
1011 | end Get_Input_Fd; | |
1012 | ||
1013 | ------------------- | |
1014 | -- Get_Output_Fd -- | |
1015 | ------------------- | |
1016 | ||
1017 | function Get_Output_Fd | |
67ee0ba6 | 1018 | (Descriptor : Process_Descriptor) return GNAT.OS_Lib.File_Descriptor |
1019 | is | |
83cce46b | 1020 | begin |
1021 | return Descriptor.Output_Fd; | |
1022 | end Get_Output_Fd; | |
1023 | ||
1024 | ------------- | |
1025 | -- Get_Pid -- | |
1026 | ------------- | |
1027 | ||
1028 | function Get_Pid | |
67ee0ba6 | 1029 | (Descriptor : Process_Descriptor) return Process_Id |
1030 | is | |
83cce46b | 1031 | begin |
1032 | return Descriptor.Pid; | |
1033 | end Get_Pid; | |
1034 | ||
c63cfa96 | 1035 | ----------------- |
1036 | -- Has_Process -- | |
1037 | ----------------- | |
1038 | ||
1039 | function Has_Process (Regexp : Multiprocess_Regexp_Array) return Boolean is | |
1040 | begin | |
1041 | return Regexp /= (Regexp'Range => (null, null)); | |
1042 | end Has_Process; | |
1043 | ||
83cce46b | 1044 | --------------- |
1045 | -- Interrupt -- | |
1046 | --------------- | |
1047 | ||
1048 | procedure Interrupt (Descriptor : in out Process_Descriptor) is | |
1049 | SIGINT : constant := 2; | |
83cce46b | 1050 | begin |
1051 | Send_Signal (Descriptor, SIGINT); | |
1052 | end Interrupt; | |
1053 | ||
1054 | ------------------ | |
1055 | -- Lock_Filters -- | |
1056 | ------------------ | |
1057 | ||
1058 | procedure Lock_Filters (Descriptor : in out Process_Descriptor) is | |
1059 | begin | |
1060 | Descriptor.Filters_Lock := Descriptor.Filters_Lock + 1; | |
1061 | end Lock_Filters; | |
1062 | ||
1063 | ------------------------ | |
1064 | -- Non_Blocking_Spawn -- | |
1065 | ------------------------ | |
1066 | ||
1067 | procedure Non_Blocking_Spawn | |
1068 | (Descriptor : out Process_Descriptor'Class; | |
1069 | Command : String; | |
1070 | Args : GNAT.OS_Lib.Argument_List; | |
1071 | Buffer_Size : Natural := 4096; | |
1072 | Err_To_Out : Boolean := False) | |
1073 | is | |
9dfe12ae | 1074 | function Fork return Process_Id; |
1075 | pragma Import (C, Fork, "__gnat_expect_fork"); | |
1076 | -- Starts a new process if possible. See the Unix command fork for more | |
1077 | -- information. On systems that do not support this capability (such as | |
1078 | -- Windows...), this command does nothing, and Fork will return | |
1079 | -- Null_Pid. | |
1080 | ||
1081 | Pipe1, Pipe2, Pipe3 : aliased Pipe_Type; | |
1082 | ||
1083 | Arg : String_Access; | |
1084 | Arg_List : String_List (1 .. Args'Length + 2); | |
c0d15e02 | 1085 | C_Arg_List : aliased array (1 .. Args'Length + 2) of System.Address; |
9dfe12ae | 1086 | |
1087 | Command_With_Path : String_Access; | |
1088 | ||
1089 | begin | |
9dfe12ae | 1090 | Command_With_Path := Locate_Exec_On_Path (Command); |
1091 | ||
1092 | if Command_With_Path = null then | |
1093 | raise Invalid_Process; | |
1094 | end if; | |
1095 | ||
0baac39e | 1096 | -- Create the rest of the pipes once we know we will be able to |
1097 | -- execute the process. | |
1098 | ||
1099 | Set_Up_Communications | |
1100 | (Descriptor, Err_To_Out, Pipe1'Access, Pipe2'Access, Pipe3'Access); | |
1101 | ||
9dfe12ae | 1102 | -- Fork a new process |
1103 | ||
1104 | Descriptor.Pid := Fork; | |
1105 | ||
1106 | -- Are we now in the child (or, for Windows, still in the common | |
1107 | -- process). | |
1108 | ||
1109 | if Descriptor.Pid = Null_Pid then | |
1110 | -- Prepare an array of arguments to pass to C | |
1111 | ||
1112 | Arg := new String (1 .. Command_With_Path'Length + 1); | |
1113 | Arg (1 .. Command_With_Path'Length) := Command_With_Path.all; | |
1114 | Arg (Arg'Last) := ASCII.NUL; | |
1115 | Arg_List (1) := Arg; | |
1116 | ||
1117 | for J in Args'Range loop | |
1118 | Arg := new String (1 .. Args (J)'Length + 1); | |
0311af6a | 1119 | Arg (1 .. Args (J)'Length) := Args (J).all; |
1120 | Arg (Arg'Last) := ASCII.NUL; | |
1121 | Arg_List (J + 2 - Args'First) := Arg.all'Access; | |
9dfe12ae | 1122 | end loop; |
1123 | ||
1124 | Arg_List (Arg_List'Last) := null; | |
1125 | ||
1126 | -- Make sure all arguments are compatible with OS conventions | |
1127 | ||
1128 | Normalize_Arguments (Arg_List); | |
1129 | ||
1130 | -- Prepare low-level argument list from the normalized arguments | |
1131 | ||
1132 | for K in Arg_List'Range loop | |
8d1e3745 | 1133 | C_Arg_List (K) := |
1134 | (if Arg_List (K) /= null | |
1135 | then Arg_List (K).all'Address | |
1136 | else System.Null_Address); | |
9dfe12ae | 1137 | end loop; |
1138 | ||
1139 | -- This does not return on Unix systems | |
1140 | ||
1141 | Set_Up_Child_Communications | |
1142 | (Descriptor, Pipe1, Pipe2, Pipe3, Command_With_Path.all, | |
1143 | C_Arg_List'Address); | |
1144 | end if; | |
1145 | ||
1146 | Free (Command_With_Path); | |
1147 | ||
1148 | -- Did we have an error when spawning the child ? | |
1149 | ||
1150 | if Descriptor.Pid < Null_Pid then | |
1151 | raise Invalid_Process; | |
1152 | else | |
1153 | -- We are now in the parent process | |
1154 | ||
1155 | Set_Up_Parent_Communications (Descriptor, Pipe1, Pipe2, Pipe3); | |
1156 | end if; | |
1157 | ||
1158 | -- Create the buffer | |
1159 | ||
1160 | Descriptor.Buffer_Size := Buffer_Size; | |
1161 | ||
1162 | if Buffer_Size /= 0 then | |
1163 | Descriptor.Buffer := new String (1 .. Positive (Buffer_Size)); | |
1164 | end if; | |
40668b4e | 1165 | |
1166 | -- Initialize the filters | |
1167 | ||
1168 | Descriptor.Filters := null; | |
9dfe12ae | 1169 | end Non_Blocking_Spawn; |
83cce46b | 1170 | |
1171 | ------------------------- | |
1172 | -- Reinitialize_Buffer -- | |
1173 | ------------------------- | |
1174 | ||
1175 | procedure Reinitialize_Buffer | |
1176 | (Descriptor : in out Process_Descriptor'Class) | |
1177 | is | |
1178 | begin | |
1179 | if Descriptor.Buffer_Size = 0 then | |
1180 | declare | |
1181 | Tmp : String_Access := Descriptor.Buffer; | |
1182 | ||
1183 | begin | |
1184 | Descriptor.Buffer := | |
1185 | new String | |
1186 | (1 .. Descriptor.Buffer_Index - Descriptor.Last_Match_End); | |
1187 | ||
1188 | if Tmp /= null then | |
1189 | Descriptor.Buffer.all := Tmp | |
1190 | (Descriptor.Last_Match_End + 1 .. Descriptor.Buffer_Index); | |
1191 | Free (Tmp); | |
1192 | end if; | |
1193 | end; | |
1194 | ||
1195 | Descriptor.Buffer_Index := Descriptor.Buffer'Last; | |
1196 | ||
1197 | else | |
1198 | Descriptor.Buffer | |
1199 | (1 .. Descriptor.Buffer_Index - Descriptor.Last_Match_End) := | |
1200 | Descriptor.Buffer | |
1201 | (Descriptor.Last_Match_End + 1 .. Descriptor.Buffer_Index); | |
1202 | ||
1203 | if Descriptor.Buffer_Index > Descriptor.Last_Match_End then | |
1204 | Descriptor.Buffer_Index := | |
1205 | Descriptor.Buffer_Index - Descriptor.Last_Match_End; | |
1206 | else | |
1207 | Descriptor.Buffer_Index := 0; | |
1208 | end if; | |
1209 | end if; | |
1210 | ||
1211 | Descriptor.Last_Match_Start := 0; | |
1212 | Descriptor.Last_Match_End := 0; | |
1213 | end Reinitialize_Buffer; | |
1214 | ||
1215 | ------------------- | |
1216 | -- Remove_Filter -- | |
1217 | ------------------- | |
1218 | ||
1219 | procedure Remove_Filter | |
1220 | (Descriptor : in out Process_Descriptor; | |
1221 | Filter : Filter_Function) | |
1222 | is | |
1223 | Previous : Filter_List := null; | |
1224 | Current : Filter_List := Descriptor.Filters; | |
1225 | ||
1226 | begin | |
1227 | while Current /= null loop | |
1228 | if Current.Filter = Filter then | |
1229 | if Previous = null then | |
1230 | Descriptor.Filters := Current.Next; | |
1231 | else | |
1232 | Previous.Next := Current.Next; | |
1233 | end if; | |
1234 | end if; | |
1235 | ||
1236 | Previous := Current; | |
1237 | Current := Current.Next; | |
1238 | end loop; | |
1239 | end Remove_Filter; | |
1240 | ||
1241 | ---------- | |
1242 | -- Send -- | |
1243 | ---------- | |
1244 | ||
1245 | procedure Send | |
c0d15e02 | 1246 | (Descriptor : in out Process_Descriptor; |
1247 | Str : String; | |
1248 | Add_LF : Boolean := True; | |
83cce46b | 1249 | Empty_Buffer : Boolean := False) |
1250 | is | |
67ee0ba6 | 1251 | Line_Feed : aliased constant String := (1 .. 1 => ASCII.LF); |
83cce46b | 1252 | Descriptors : Array_Of_Pd := (1 => Descriptor'Unrestricted_Access); |
1253 | ||
96da3284 | 1254 | Result : Expect_Match; |
c0d40c9a | 1255 | Discard : Natural; |
96da3284 | 1256 | pragma Warnings (Off, Result); |
c0d40c9a | 1257 | pragma Warnings (Off, Discard); |
9dfe12ae | 1258 | |
83cce46b | 1259 | begin |
1260 | if Empty_Buffer then | |
1261 | ||
d72ec39e | 1262 | -- Force a read on the process if there is anything waiting |
83cce46b | 1263 | |
67ee0ba6 | 1264 | Expect_Internal |
1265 | (Descriptors, Result, Timeout => 0, Full_Buffer => False); | |
c63cfa96 | 1266 | |
1267 | if Result = Expect_Internal_Error | |
1268 | or else Result = Expect_Process_Died | |
1269 | then | |
1270 | raise Process_Died; | |
1271 | end if; | |
1272 | ||
83cce46b | 1273 | Descriptor.Last_Match_End := Descriptor.Buffer_Index; |
1274 | ||
1275 | -- Empty the buffer | |
1276 | ||
1277 | Reinitialize_Buffer (Descriptor); | |
1278 | end if; | |
1279 | ||
67ee0ba6 | 1280 | Call_Filters (Descriptor, Str, Input); |
1281 | Discard := | |
1282 | Write (Descriptor.Input_Fd, Str'Address, Str'Last - Str'First + 1); | |
1283 | ||
83cce46b | 1284 | if Add_LF then |
67ee0ba6 | 1285 | Call_Filters (Descriptor, Line_Feed, Input); |
1286 | Discard := | |
1287 | Write (Descriptor.Input_Fd, Line_Feed'Address, 1); | |
83cce46b | 1288 | end if; |
83cce46b | 1289 | end Send; |
1290 | ||
1291 | ----------------- | |
1292 | -- Send_Signal -- | |
1293 | ----------------- | |
1294 | ||
1295 | procedure Send_Signal | |
1296 | (Descriptor : Process_Descriptor; | |
1297 | Signal : Integer) | |
1298 | is | |
1299 | begin | |
67ee0ba6 | 1300 | -- A nonpositive process id passed to kill has special meanings. For |
1301 | -- example, -1 means kill all processes in sight, including self, in | |
1302 | -- POSIX and Windows (and something slightly different in Linux). See | |
1303 | -- man pages for details. In any case, we don't want to do that. Note | |
1304 | -- that Descriptor.Pid will be -1 if the process was not successfully | |
1305 | -- started; we don't want to kill ourself in that case. | |
1306 | ||
1307 | if Descriptor.Pid > 0 then | |
1308 | Kill (Descriptor.Pid, Signal, Close => 1); | |
1309 | -- ??? Need to check process status here | |
1310 | else | |
1311 | raise Invalid_Process; | |
1312 | end if; | |
83cce46b | 1313 | end Send_Signal; |
1314 | ||
1315 | --------------------------------- | |
1316 | -- Set_Up_Child_Communications -- | |
1317 | --------------------------------- | |
1318 | ||
1319 | procedure Set_Up_Child_Communications | |
1320 | (Pid : in out Process_Descriptor; | |
1321 | Pipe1 : in out Pipe_Type; | |
1322 | Pipe2 : in out Pipe_Type; | |
1323 | Pipe3 : in out Pipe_Type; | |
0311af6a | 1324 | Cmd : String; |
1325 | Args : System.Address) | |
83cce46b | 1326 | is |
f15731c4 | 1327 | pragma Warnings (Off, Pid); |
4540a696 | 1328 | pragma Warnings (Off, Pipe1); |
1329 | pragma Warnings (Off, Pipe2); | |
1330 | pragma Warnings (Off, Pipe3); | |
f15731c4 | 1331 | |
1332 | Input : File_Descriptor; | |
1333 | Output : File_Descriptor; | |
1334 | Error : File_Descriptor; | |
83cce46b | 1335 | |
920e81b8 | 1336 | No_Fork_On_Target : constant Boolean := Target_OS = Windows; |
1337 | ||
83cce46b | 1338 | begin |
920e81b8 | 1339 | if No_Fork_On_Target then |
b2738a24 | 1340 | |
57998683 | 1341 | -- Since Windows does not have a separate fork/exec, we need to |
1342 | -- perform the following actions: | |
b2738a24 | 1343 | |
57998683 | 1344 | -- - save stdin, stdout, stderr |
1345 | -- - replace them by our pipes | |
1346 | -- - create the child with process handle inheritance | |
1347 | -- - revert to the previous stdin, stdout and stderr. | |
1348 | ||
1349 | Input := Dup (GNAT.OS_Lib.Standin); | |
1350 | Output := Dup (GNAT.OS_Lib.Standout); | |
1351 | Error := Dup (GNAT.OS_Lib.Standerr); | |
1352 | end if; | |
83cce46b | 1353 | |
1354 | -- Since we are still called from the parent process, there is no way | |
1355 | -- currently we can cleanly close the unneeded ends of the pipes, but | |
1356 | -- this doesn't really matter. | |
4540a696 | 1357 | |
1358 | -- We could close Pipe1.Output, Pipe2.Input, Pipe3.Input | |
83cce46b | 1359 | |
1360 | Dup2 (Pipe1.Input, GNAT.OS_Lib.Standin); | |
1361 | Dup2 (Pipe2.Output, GNAT.OS_Lib.Standout); | |
1362 | Dup2 (Pipe3.Output, GNAT.OS_Lib.Standerr); | |
1363 | ||
051b558d | 1364 | Portable_Execvp (Pid.Pid'Access, Cmd & ASCII.NUL, Args); |
83cce46b | 1365 | |
0b04b414 | 1366 | -- The following lines are only required for Windows systems and will |
1367 | -- not be executed on Unix systems, but we use the same condition as | |
1368 | -- above to avoid warnings on uninitialized variables on Unix systems. | |
1369 | -- We are now in the parent process. | |
83cce46b | 1370 | |
0b04b414 | 1371 | if No_Fork_On_Target then |
1372 | ||
1373 | -- Restore the old descriptors | |
83cce46b | 1374 | |
0b04b414 | 1375 | Dup2 (Input, GNAT.OS_Lib.Standin); |
1376 | Dup2 (Output, GNAT.OS_Lib.Standout); | |
1377 | Dup2 (Error, GNAT.OS_Lib.Standerr); | |
1378 | Close (Input); | |
1379 | Close (Output); | |
1380 | Close (Error); | |
1381 | end if; | |
83cce46b | 1382 | end Set_Up_Child_Communications; |
1383 | ||
1384 | --------------------------- | |
1385 | -- Set_Up_Communications -- | |
1386 | --------------------------- | |
1387 | ||
1388 | procedure Set_Up_Communications | |
1389 | (Pid : in out Process_Descriptor; | |
1390 | Err_To_Out : Boolean; | |
ecfefb70 | 1391 | Pipe1 : not null access Pipe_Type; |
1392 | Pipe2 : not null access Pipe_Type; | |
1393 | Pipe3 : not null access Pipe_Type) | |
f15731c4 | 1394 | is |
6d9c3443 | 1395 | Status : Boolean; |
96da3284 | 1396 | pragma Unreferenced (Status); |
6d9c3443 | 1397 | |
83cce46b | 1398 | begin |
1399 | -- Create the pipes | |
1400 | ||
1401 | if Create_Pipe (Pipe1) /= 0 then | |
1402 | return; | |
1403 | end if; | |
1404 | ||
1405 | if Create_Pipe (Pipe2) /= 0 then | |
0baac39e | 1406 | Close (Pipe1.Input); |
1407 | Close (Pipe1.Output); | |
83cce46b | 1408 | return; |
1409 | end if; | |
1410 | ||
6d9c3443 | 1411 | -- Record the 'parent' end of the two pipes in Pid: |
1412 | -- Child stdin is connected to the 'write' end of Pipe1; | |
1413 | -- Child stdout is connected to the 'read' end of Pipe2. | |
1414 | -- We do not want these descriptors to remain open in the child | |
1415 | -- process, so we mark them close-on-exec/non-inheritable. | |
1416 | ||
83cce46b | 1417 | Pid.Input_Fd := Pipe1.Output; |
6d9c3443 | 1418 | Set_Close_On_Exec (Pipe1.Output, True, Status); |
83cce46b | 1419 | Pid.Output_Fd := Pipe2.Input; |
6d9c3443 | 1420 | Set_Close_On_Exec (Pipe2.Input, True, Status); |
83cce46b | 1421 | |
1422 | if Err_To_Out then | |
6d9c3443 | 1423 | |
1424 | -- Reuse the standard output pipe for standard error | |
1425 | ||
83cce46b | 1426 | Pipe3.all := Pipe2.all; |
6d9c3443 | 1427 | |
57998683 | 1428 | else |
6d9c3443 | 1429 | -- Create a separate pipe for standard error |
1430 | ||
83cce46b | 1431 | if Create_Pipe (Pipe3) /= 0 then |
0baac39e | 1432 | Pipe3.all := Pipe2.all; |
83cce46b | 1433 | end if; |
1434 | end if; | |
1435 | ||
67ee0ba6 | 1436 | -- As above, record the proper fd for the child's standard error stream |
6d9c3443 | 1437 | |
83cce46b | 1438 | Pid.Error_Fd := Pipe3.Input; |
6d9c3443 | 1439 | Set_Close_On_Exec (Pipe3.Input, True, Status); |
83cce46b | 1440 | end Set_Up_Communications; |
1441 | ||
1442 | ---------------------------------- | |
1443 | -- Set_Up_Parent_Communications -- | |
1444 | ---------------------------------- | |
1445 | ||
1446 | procedure Set_Up_Parent_Communications | |
1447 | (Pid : in out Process_Descriptor; | |
1448 | Pipe1 : in out Pipe_Type; | |
1449 | Pipe2 : in out Pipe_Type; | |
1450 | Pipe3 : in out Pipe_Type) | |
1451 | is | |
f15731c4 | 1452 | pragma Warnings (Off, Pid); |
4540a696 | 1453 | pragma Warnings (Off, Pipe1); |
1454 | pragma Warnings (Off, Pipe2); | |
1455 | pragma Warnings (Off, Pipe3); | |
fd66bc6b | 1456 | |
83cce46b | 1457 | begin |
1458 | Close (Pipe1.Input); | |
1459 | Close (Pipe2.Output); | |
fd66bc6b | 1460 | |
1461 | if Pipe3.Output /= Pipe2.Output then | |
1462 | Close (Pipe3.Output); | |
1463 | end if; | |
83cce46b | 1464 | end Set_Up_Parent_Communications; |
1465 | ||
1466 | ------------------ | |
1467 | -- Trace_Filter -- | |
1468 | ------------------ | |
1469 | ||
1470 | procedure Trace_Filter | |
1471 | (Descriptor : Process_Descriptor'Class; | |
1472 | Str : String; | |
1473 | User_Data : System.Address := System.Null_Address) | |
1474 | is | |
f15731c4 | 1475 | pragma Warnings (Off, Descriptor); |
1476 | pragma Warnings (Off, User_Data); | |
83cce46b | 1477 | begin |
1478 | GNAT.IO.Put (Str); | |
1479 | end Trace_Filter; | |
1480 | ||
1481 | -------------------- | |
1482 | -- Unlock_Filters -- | |
1483 | -------------------- | |
1484 | ||
1485 | procedure Unlock_Filters (Descriptor : in out Process_Descriptor) is | |
1486 | begin | |
1487 | if Descriptor.Filters_Lock > 0 then | |
1488 | Descriptor.Filters_Lock := Descriptor.Filters_Lock - 1; | |
1489 | end if; | |
1490 | end Unlock_Filters; | |
1491 | ||
1492 | end GNAT.Expect; |