1 ------------------------------------------------------------------------------
3 -- GNAT LIBRARY COMPONENTS --
5 -- G N A T . E X P E C T --
9 -- Copyright (C) 2000-2006, AdaCore --
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- --
13 -- ware Foundation; either version 2, or (at your option) any later ver- --
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 --
16 -- or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License --
17 -- for more details. You should have received a copy of the GNU General --
18 -- Public License distributed with GNAT; see file COPYING. If not, write --
19 -- to the Free Software Foundation, 51 Franklin Street, Fifth Floor, --
20 -- Boston, MA 02110-1301, USA. --
22 -- As a special exception, if other files instantiate generics from this --
23 -- unit, or you link this unit with other files to produce an executable, --
24 -- this unit does not by itself cause the resulting executable to be --
25 -- covered by the GNU General Public License. This exception does not --
26 -- however invalidate any other reasons why the executable file might be --
27 -- covered by the GNU Public License. --
29 -- GNAT was originally developed by the GNAT team at New York University. --
30 -- Extensive contributions were provided by Ada Core Technologies Inc. --
32 ------------------------------------------------------------------------------
34 with System; use System;
35 with Ada.Calendar; use Ada.Calendar;
38 with GNAT.OS_Lib; use GNAT.OS_Lib;
39 with GNAT.Regpat; use GNAT.Regpat;
41 with Unchecked_Deallocation;
43 package body GNAT.Expect is
45 type Array_Of_Pd is array (Positive range <>) of Process_Descriptor_Access;
47 procedure Expect_Internal
48 (Descriptors : in out Array_Of_Pd;
49 Result : out Expect_Match;
51 Full_Buffer : Boolean);
52 -- Internal function used to read from the process Descriptor.
54 -- Three outputs are possible:
55 -- Result=Expect_Timeout, if no output was available before the timeout
57 -- Result=Expect_Full_Buffer, if Full_Buffer is True and some characters
58 -- had to be discarded from the internal buffer of Descriptor.
59 -- Result=<integer>, indicates how many characters were added to the
60 -- internal buffer. These characters are from indexes
61 -- Descriptor.Buffer_Index - Result + 1 .. Descriptor.Buffer_Index
62 -- Process_Died is raised if the process is no longer valid.
64 procedure Reinitialize_Buffer
65 (Descriptor : in out Process_Descriptor'Class);
66 -- Reinitialize the internal buffer.
67 -- The buffer is deleted up to the end of the last match.
69 procedure Free is new Unchecked_Deallocation
70 (Pattern_Matcher, Pattern_Matcher_Access);
72 procedure Free is new Unchecked_Deallocation
73 (Filter_List_Elem, Filter_List);
75 procedure Call_Filters
76 (Pid : Process_Descriptor'Class;
78 Filter_On : Filter_Type);
79 -- Call all the filters that have the appropriate type.
80 -- This function does nothing if the filters are locked
82 ------------------------------
83 -- Target dependent section --
84 ------------------------------
86 function Dup (Fd : File_Descriptor) return File_Descriptor;
87 pragma Import (C, Dup);
89 procedure Dup2 (Old_Fd, New_Fd : File_Descriptor);
90 pragma Import (C, Dup2);
92 procedure Kill (Pid : Process_Id; Sig_Num : Integer; Close : Integer);
93 pragma Import (C, Kill, "__gnat_kill");
94 -- if Close is set to 1 all OS resources used by the Pid must be freed
96 function Create_Pipe (Pipe : not null access Pipe_Type) return Integer;
97 pragma Import (C, Create_Pipe, "__gnat_pipe");
100 (Fds : System.Address;
103 Is_Set : System.Address)
105 pragma Import (C, Poll, "__gnat_expect_poll");
106 -- Check whether there is any data waiting on the file descriptor
107 -- Out_fd, and wait if there is none, at most Timeout milliseconds
108 -- Returns -1 in case of error, 0 if the timeout expired before
109 -- data became available.
111 -- Out_Is_Set is set to 1 if data was available, 0 otherwise.
113 function Waitpid (Pid : Process_Id) return Integer;
114 pragma Import (C, Waitpid, "__gnat_waitpid");
115 -- Wait for a specific process id, and return its exit code
121 function "+" (S : String) return GNAT.OS_Lib.String_Access is
123 return new String'(S);
131 (P : GNAT.Regpat.Pattern_Matcher)
132 return Pattern_Matcher_Access
135 return new GNAT.Regpat.Pattern_Matcher'(P);
143 (Descriptor : in out Process_Descriptor;
144 Filter : Filter_Function;
145 Filter_On : Filter_Type := Output;
146 User_Data : System.Address := System.Null_Address;
147 After : Boolean := False)
149 Current : Filter_List := Descriptor.Filters;
153 while Current /= null and then Current.Next /= null loop
154 Current := Current.Next;
157 if Current = null then
158 Descriptor.Filters :=
159 new Filter_List_Elem'
160 (Filter => Filter, Filter_On => Filter_On,
161 User_Data => User_Data, Next => null);
164 new Filter_List_Elem'
165 (Filter => Filter, Filter_On => Filter_On,
166 User_Data => User_Data, Next => null);
170 Descriptor.Filters :=
171 new Filter_List_Elem'
172 (Filter => Filter, Filter_On => Filter_On,
173 User_Data => User_Data, Next => Descriptor.Filters);
181 procedure Call_Filters
182 (Pid : Process_Descriptor'Class;
184 Filter_On : Filter_Type)
186 Current_Filter : Filter_List;
189 if Pid.Filters_Lock = 0 then
190 Current_Filter := Pid.Filters;
192 while Current_Filter /= null loop
193 if Current_Filter.Filter_On = Filter_On then
194 Current_Filter.Filter
195 (Pid, Str, Current_Filter.User_Data);
198 Current_Filter := Current_Filter.Next;
208 (Descriptor : in out Process_Descriptor;
209 Status : out Integer)
211 Current_Filter : Filter_List;
212 Next_Filter : Filter_List;
215 Close (Descriptor.Input_Fd);
217 if Descriptor.Error_Fd /= Descriptor.Output_Fd then
218 Close (Descriptor.Error_Fd);
221 Close (Descriptor.Output_Fd);
223 -- ??? Should have timeouts for different signals
225 Kill (Descriptor.Pid, 9, 0);
227 GNAT.OS_Lib.Free (Descriptor.Buffer);
228 Descriptor.Buffer_Size := 0;
230 Current_Filter := Descriptor.Filters;
232 while Current_Filter /= null loop
233 Next_Filter := Current_Filter.Next;
234 Free (Current_Filter);
235 Current_Filter := Next_Filter;
238 Descriptor.Filters := null;
239 Status := Waitpid (Descriptor.Pid);
242 procedure Close (Descriptor : in out Process_Descriptor) is
245 Close (Descriptor, Status);
253 (Descriptor : in out Process_Descriptor;
254 Result : out Expect_Match;
256 Timeout : Integer := 10000;
257 Full_Buffer : Boolean := False)
261 Expect (Descriptor, Result, Never_Match, Timeout, Full_Buffer);
263 Expect (Descriptor, Result, Compile (Regexp), Timeout, Full_Buffer);
268 (Descriptor : in out Process_Descriptor;
269 Result : out Expect_Match;
271 Matched : out GNAT.Regpat.Match_Array;
272 Timeout : Integer := 10000;
273 Full_Buffer : Boolean := False)
276 pragma Assert (Matched'First = 0);
279 (Descriptor, Result, Never_Match, Matched, Timeout, Full_Buffer);
282 (Descriptor, Result, Compile (Regexp), Matched, Timeout,
288 (Descriptor : in out Process_Descriptor;
289 Result : out Expect_Match;
290 Regexp : GNAT.Regpat.Pattern_Matcher;
291 Timeout : Integer := 10000;
292 Full_Buffer : Boolean := False)
294 Matched : GNAT.Regpat.Match_Array (0 .. 0);
297 Expect (Descriptor, Result, Regexp, Matched, Timeout, Full_Buffer);
301 (Descriptor : in out Process_Descriptor;
302 Result : out Expect_Match;
303 Regexp : GNAT.Regpat.Pattern_Matcher;
304 Matched : out GNAT.Regpat.Match_Array;
305 Timeout : Integer := 10000;
306 Full_Buffer : Boolean := False)
309 Descriptors : Array_Of_Pd := (1 => Descriptor'Unrestricted_Access);
310 Try_Until : constant Time := Clock + Duration (Timeout) / 1000.0;
311 Timeout_Tmp : Integer := Timeout;
314 pragma Assert (Matched'First = 0);
315 Reinitialize_Buffer (Descriptor);
318 -- First, test if what is already in the buffer matches (This is
319 -- required if this package is used in multi-task mode, since one of
320 -- the tasks might have added something in the buffer, and we don't
321 -- want other tasks to wait for new input to be available before
322 -- checking the regexps).
325 (Regexp, Descriptor.Buffer (1 .. Descriptor.Buffer_Index), Matched);
327 if Descriptor.Buffer_Index >= 1 and then Matched (0).First /= 0 then
329 Descriptor.Last_Match_Start := Matched (0).First;
330 Descriptor.Last_Match_End := Matched (0).Last;
334 -- Else try to read new input
336 Expect_Internal (Descriptors, N, Timeout_Tmp, Full_Buffer);
338 if N = Expect_Timeout or else N = Expect_Full_Buffer then
343 -- Calculate the timeout for the next turn
345 -- Note that Timeout is, from the caller's perspective, the maximum
346 -- time until a match, not the maximum time until some output is
347 -- read, and thus cannot be reused as is for Expect_Internal.
349 if Timeout /= -1 then
350 Timeout_Tmp := Integer (Try_Until - Clock) * 1000;
352 if Timeout_Tmp < 0 then
353 Result := Expect_Timeout;
359 -- Even if we had the general timeout above, we have to test that the
360 -- last test we read from the external process didn't match.
363 (Regexp, Descriptor.Buffer (1 .. Descriptor.Buffer_Index), Matched);
365 if Matched (0).First /= 0 then
367 Descriptor.Last_Match_Start := Matched (0).First;
368 Descriptor.Last_Match_End := Matched (0).Last;
374 (Descriptor : in out Process_Descriptor;
375 Result : out Expect_Match;
376 Regexps : Regexp_Array;
377 Timeout : Integer := 10000;
378 Full_Buffer : Boolean := False)
380 Patterns : Compiled_Regexp_Array (Regexps'Range);
381 Matched : GNAT.Regpat.Match_Array (0 .. 0);
384 for J in Regexps'Range loop
385 Patterns (J) := new Pattern_Matcher'(Compile (Regexps (J).all));
388 Expect (Descriptor, Result, Patterns, Matched, Timeout, Full_Buffer);
390 for J in Regexps'Range loop
396 (Descriptor : in out Process_Descriptor;
397 Result : out Expect_Match;
398 Regexps : Compiled_Regexp_Array;
399 Timeout : Integer := 10000;
400 Full_Buffer : Boolean := False)
402 Matched : GNAT.Regpat.Match_Array (0 .. 0);
405 Expect (Descriptor, Result, Regexps, Matched, Timeout, Full_Buffer);
409 (Result : out Expect_Match;
410 Regexps : Multiprocess_Regexp_Array;
411 Timeout : Integer := 10000;
412 Full_Buffer : Boolean := False)
414 Matched : GNAT.Regpat.Match_Array (0 .. 0);
417 Expect (Result, Regexps, Matched, Timeout, Full_Buffer);
421 (Descriptor : in out Process_Descriptor;
422 Result : out Expect_Match;
423 Regexps : Regexp_Array;
424 Matched : out GNAT.Regpat.Match_Array;
425 Timeout : Integer := 10000;
426 Full_Buffer : Boolean := False)
428 Patterns : Compiled_Regexp_Array (Regexps'Range);
431 pragma Assert (Matched'First = 0);
433 for J in Regexps'Range loop
434 Patterns (J) := new Pattern_Matcher'(Compile (Regexps (J).all));
437 Expect (Descriptor, Result, Patterns, Matched, Timeout, Full_Buffer);
439 for J in Regexps'Range loop
445 (Descriptor : in out Process_Descriptor;
446 Result : out Expect_Match;
447 Regexps : Compiled_Regexp_Array;
448 Matched : out GNAT.Regpat.Match_Array;
449 Timeout : Integer := 10000;
450 Full_Buffer : Boolean := False)
453 Descriptors : Array_Of_Pd := (1 => Descriptor'Unrestricted_Access);
456 pragma Assert (Matched'First = 0);
458 Reinitialize_Buffer (Descriptor);
461 -- First, test if what is already in the buffer matches (This is
462 -- required if this package is used in multi-task mode, since one of
463 -- the tasks might have added something in the buffer, and we don't
464 -- want other tasks to wait for new input to be available before
465 -- checking the regexps).
467 if Descriptor.Buffer /= null then
468 for J in Regexps'Range loop
471 Descriptor.Buffer (1 .. Descriptor.Buffer_Index),
474 if Matched (0) /= No_Match then
475 Result := Expect_Match (J);
476 Descriptor.Last_Match_Start := Matched (0).First;
477 Descriptor.Last_Match_End := Matched (0).Last;
483 Expect_Internal (Descriptors, N, Timeout, Full_Buffer);
485 if N = Expect_Timeout or else N = Expect_Full_Buffer then
493 (Result : out Expect_Match;
494 Regexps : Multiprocess_Regexp_Array;
495 Matched : out GNAT.Regpat.Match_Array;
496 Timeout : Integer := 10000;
497 Full_Buffer : Boolean := False)
500 Descriptors : Array_Of_Pd (Regexps'Range);
503 pragma Assert (Matched'First = 0);
505 for J in Descriptors'Range loop
506 Descriptors (J) := Regexps (J).Descriptor;
507 Reinitialize_Buffer (Regexps (J).Descriptor.all);
511 -- First, test if what is already in the buffer matches (This is
512 -- required if this package is used in multi-task mode, since one of
513 -- the tasks might have added something in the buffer, and we don't
514 -- want other tasks to wait for new input to be available before
515 -- checking the regexps).
517 for J in Regexps'Range loop
518 Match (Regexps (J).Regexp.all,
519 Regexps (J).Descriptor.Buffer
520 (1 .. Regexps (J).Descriptor.Buffer_Index),
523 if Matched (0) /= No_Match then
524 Result := Expect_Match (J);
525 Regexps (J).Descriptor.Last_Match_Start := Matched (0).First;
526 Regexps (J).Descriptor.Last_Match_End := Matched (0).Last;
531 Expect_Internal (Descriptors, N, Timeout, Full_Buffer);
533 if N = Expect_Timeout or else N = Expect_Full_Buffer then
540 ---------------------
541 -- Expect_Internal --
542 ---------------------
544 procedure Expect_Internal
545 (Descriptors : in out Array_Of_Pd;
546 Result : out Expect_Match;
548 Full_Buffer : Boolean)
550 Num_Descriptors : Integer;
551 Buffer_Size : Integer := 0;
555 type File_Descriptor_Array is
556 array (Descriptors'Range) of File_Descriptor;
557 Fds : aliased File_Descriptor_Array;
559 type Integer_Array is array (Descriptors'Range) of Integer;
560 Is_Set : aliased Integer_Array;
563 for J in Descriptors'Range loop
564 Fds (J) := Descriptors (J).Output_Fd;
566 if Descriptors (J).Buffer_Size = 0 then
567 Buffer_Size := Integer'Max (Buffer_Size, 4096);
570 Integer'Max (Buffer_Size, Descriptors (J).Buffer_Size);
575 Buffer : aliased String (1 .. Buffer_Size);
576 -- Buffer used for input. This is allocated only once, not for
577 -- every iteration of the loop
580 -- Loop until we match or we have a timeout
584 Poll (Fds'Address, Fds'Length, Timeout, Is_Set'Address);
586 case Num_Descriptors is
596 Result := Expect_Timeout;
602 for J in Descriptors'Range loop
603 if Is_Set (J) = 1 then
604 Buffer_Size := Descriptors (J).Buffer_Size;
606 if Buffer_Size = 0 then
610 N := Read (Descriptors (J).Output_Fd, Buffer'Address,
613 -- Error or End of file
616 -- ??? Note that ddd tries again up to three times
617 -- in that case. See LiterateA.C:174
621 -- If there is no limit to the buffer size
623 if Descriptors (J).Buffer_Size = 0 then
626 Tmp : String_Access := Descriptors (J).Buffer;
630 Descriptors (J).Buffer :=
631 new String (1 .. Tmp'Length + N);
632 Descriptors (J).Buffer (1 .. Tmp'Length) :=
634 Descriptors (J).Buffer
635 (Tmp'Length + 1 .. Tmp'Length + N) :=
638 Descriptors (J).Buffer_Index :=
639 Descriptors (J).Buffer'Last;
642 Descriptors (J).Buffer :=
644 Descriptors (J).Buffer.all :=
646 Descriptors (J).Buffer_Index := N;
651 -- Add what we read to the buffer
653 if Descriptors (J).Buffer_Index + N - 1 >
654 Descriptors (J).Buffer_Size
656 -- If the user wants to know when we have
657 -- read more than the buffer can contain.
660 Result := Expect_Full_Buffer;
664 -- Keep as much as possible from the buffer,
665 -- and forget old characters.
667 Descriptors (J).Buffer
668 (1 .. Descriptors (J).Buffer_Size - N) :=
669 Descriptors (J).Buffer
670 (N - Descriptors (J).Buffer_Size +
671 Descriptors (J).Buffer_Index + 1 ..
672 Descriptors (J).Buffer_Index);
673 Descriptors (J).Buffer_Index :=
674 Descriptors (J).Buffer_Size - N;
677 -- Keep what we read in the buffer
679 Descriptors (J).Buffer
680 (Descriptors (J).Buffer_Index + 1 ..
681 Descriptors (J).Buffer_Index + N) :=
683 Descriptors (J).Buffer_Index :=
684 Descriptors (J).Buffer_Index + N;
687 -- Call each of the output filter with what we
691 (Descriptors (J).all, Buffer (1 .. N), Output);
693 Result := Expect_Match (N);
707 function Expect_Out (Descriptor : Process_Descriptor) return String is
709 return Descriptor.Buffer (1 .. Descriptor.Last_Match_End);
712 ----------------------
713 -- Expect_Out_Match --
714 ----------------------
716 function Expect_Out_Match (Descriptor : Process_Descriptor) return String is
718 return Descriptor.Buffer
719 (Descriptor.Last_Match_Start .. Descriptor.Last_Match_End);
720 end Expect_Out_Match;
727 (Descriptor : in out Process_Descriptor;
728 Timeout : Integer := 0)
730 Buffer_Size : constant Integer := 8192;
731 Num_Descriptors : Integer;
733 Is_Set : aliased Integer;
734 Buffer : aliased String (1 .. Buffer_Size);
737 -- Empty the current buffer
739 Descriptor.Last_Match_End := Descriptor.Buffer_Index;
740 Reinitialize_Buffer (Descriptor);
742 -- Read everything from the process to flush its output
746 Poll (Descriptor.Output_Fd'Address, 1, Timeout, Is_Set'Address);
748 case Num_Descriptors is
755 -- Timeout => End of flush
764 N := Read (Descriptor.Output_Fd, Buffer'Address,
777 ------------------------
778 -- Get_Command_Output --
779 ------------------------
781 function Get_Command_Output
783 Arguments : GNAT.OS_Lib.Argument_List;
785 Status : not null access Integer;
786 Err_To_Out : Boolean := False) return String
790 Process : Process_Descriptor;
792 Output : String_Access := new String (1 .. 1024);
793 -- Buffer used to accumulate standard output from the launched
794 -- command, expanded as necessary during execution.
797 -- Index of the last used character within Output
801 (Process, Command, Arguments, Err_To_Out => Err_To_Out);
803 if Input'Length > 0 then
804 Send (Process, Input);
807 GNAT.OS_Lib.Close (Get_Input_Fd (Process));
810 Result : Expect_Match;
813 -- This loop runs until the call to Expect raises Process_Died
816 Expect (Process, Result, ".+");
819 NOutput : String_Access;
820 S : constant String := Expect_Out (Process);
821 pragma Assert (S'Length > 0);
824 -- Expand buffer if we need more space. Note here that we add
825 -- S'Length to ensure that S will fit in the new buffer size.
827 if Last + S'Length > Output'Last then
828 NOutput := new String (1 .. 2 * Output'Last + S'Length);
829 NOutput (Output'Range) := Output.all;
832 -- Here if current buffer size is OK
838 NOutput (Last + 1 .. Last + S'Length) := S;
839 Last := Last + S'Length;
846 Close (Process, Status.all);
854 S : constant String := Output (1 .. Last);
859 end Get_Command_Output;
865 function Get_Error_Fd
866 (Descriptor : Process_Descriptor) return GNAT.OS_Lib.File_Descriptor is
868 return Descriptor.Error_Fd;
875 function Get_Input_Fd
876 (Descriptor : Process_Descriptor) return GNAT.OS_Lib.File_Descriptor is
878 return Descriptor.Input_Fd;
885 function Get_Output_Fd
886 (Descriptor : Process_Descriptor) return GNAT.OS_Lib.File_Descriptor is
888 return Descriptor.Output_Fd;
896 (Descriptor : Process_Descriptor) return Process_Id is
898 return Descriptor.Pid;
905 procedure Interrupt (Descriptor : in out Process_Descriptor) is
906 SIGINT : constant := 2;
909 Send_Signal (Descriptor, SIGINT);
916 procedure Lock_Filters (Descriptor : in out Process_Descriptor) is
918 Descriptor.Filters_Lock := Descriptor.Filters_Lock + 1;
921 ------------------------
922 -- Non_Blocking_Spawn --
923 ------------------------
925 procedure Non_Blocking_Spawn
926 (Descriptor : out Process_Descriptor'Class;
928 Args : GNAT.OS_Lib.Argument_List;
929 Buffer_Size : Natural := 4096;
930 Err_To_Out : Boolean := False)
932 function Fork return Process_Id;
933 pragma Import (C, Fork, "__gnat_expect_fork");
934 -- Starts a new process if possible. See the Unix command fork for more
935 -- information. On systems that do not support this capability (such as
936 -- Windows...), this command does nothing, and Fork will return
939 Pipe1, Pipe2, Pipe3 : aliased Pipe_Type;
942 Arg_List : String_List (1 .. Args'Length + 2);
943 C_Arg_List : aliased array (1 .. Args'Length + 2) of System.Address;
945 Command_With_Path : String_Access;
948 -- Create the rest of the pipes
950 Set_Up_Communications
951 (Descriptor, Err_To_Out, Pipe1'Access, Pipe2'Access, Pipe3'Access);
953 Command_With_Path := Locate_Exec_On_Path (Command);
955 if Command_With_Path = null then
956 raise Invalid_Process;
959 -- Fork a new process
961 Descriptor.Pid := Fork;
963 -- Are we now in the child (or, for Windows, still in the common
966 if Descriptor.Pid = Null_Pid then
967 -- Prepare an array of arguments to pass to C
969 Arg := new String (1 .. Command_With_Path'Length + 1);
970 Arg (1 .. Command_With_Path'Length) := Command_With_Path.all;
971 Arg (Arg'Last) := ASCII.NUL;
974 for J in Args'Range loop
975 Arg := new String (1 .. Args (J)'Length + 1);
976 Arg (1 .. Args (J)'Length) := Args (J).all;
977 Arg (Arg'Last) := ASCII.NUL;
978 Arg_List (J + 2 - Args'First) := Arg.all'Access;
981 Arg_List (Arg_List'Last) := null;
983 -- Make sure all arguments are compatible with OS conventions
985 Normalize_Arguments (Arg_List);
987 -- Prepare low-level argument list from the normalized arguments
989 for K in Arg_List'Range loop
990 if Arg_List (K) /= null then
991 C_Arg_List (K) := Arg_List (K).all'Address;
993 C_Arg_List (K) := System.Null_Address;
997 -- This does not return on Unix systems
999 Set_Up_Child_Communications
1000 (Descriptor, Pipe1, Pipe2, Pipe3, Command_With_Path.all,
1001 C_Arg_List'Address);
1004 Free (Command_With_Path);
1006 -- Did we have an error when spawning the child ?
1008 if Descriptor.Pid < Null_Pid then
1009 raise Invalid_Process;
1011 -- We are now in the parent process
1013 Set_Up_Parent_Communications (Descriptor, Pipe1, Pipe2, Pipe3);
1016 -- Create the buffer
1018 Descriptor.Buffer_Size := Buffer_Size;
1020 if Buffer_Size /= 0 then
1021 Descriptor.Buffer := new String (1 .. Positive (Buffer_Size));
1024 -- Initialize the filters
1026 Descriptor.Filters := null;
1027 end Non_Blocking_Spawn;
1029 -------------------------
1030 -- Reinitialize_Buffer --
1031 -------------------------
1033 procedure Reinitialize_Buffer
1034 (Descriptor : in out Process_Descriptor'Class)
1037 if Descriptor.Buffer_Size = 0 then
1039 Tmp : String_Access := Descriptor.Buffer;
1042 Descriptor.Buffer :=
1044 (1 .. Descriptor.Buffer_Index - Descriptor.Last_Match_End);
1047 Descriptor.Buffer.all := Tmp
1048 (Descriptor.Last_Match_End + 1 .. Descriptor.Buffer_Index);
1053 Descriptor.Buffer_Index := Descriptor.Buffer'Last;
1057 (1 .. Descriptor.Buffer_Index - Descriptor.Last_Match_End) :=
1059 (Descriptor.Last_Match_End + 1 .. Descriptor.Buffer_Index);
1061 if Descriptor.Buffer_Index > Descriptor.Last_Match_End then
1062 Descriptor.Buffer_Index :=
1063 Descriptor.Buffer_Index - Descriptor.Last_Match_End;
1065 Descriptor.Buffer_Index := 0;
1069 Descriptor.Last_Match_Start := 0;
1070 Descriptor.Last_Match_End := 0;
1071 end Reinitialize_Buffer;
1077 procedure Remove_Filter
1078 (Descriptor : in out Process_Descriptor;
1079 Filter : Filter_Function)
1081 Previous : Filter_List := null;
1082 Current : Filter_List := Descriptor.Filters;
1085 while Current /= null loop
1086 if Current.Filter = Filter then
1087 if Previous = null then
1088 Descriptor.Filters := Current.Next;
1090 Previous.Next := Current.Next;
1094 Previous := Current;
1095 Current := Current.Next;
1104 (Descriptor : in out Process_Descriptor;
1106 Add_LF : Boolean := True;
1107 Empty_Buffer : Boolean := False)
1109 Full_Str : constant String := Str & ASCII.LF;
1111 Result : Expect_Match;
1112 Descriptors : Array_Of_Pd := (1 => Descriptor'Unrestricted_Access);
1115 pragma Warnings (Off, Discard);
1118 if Empty_Buffer then
1120 -- Force a read on the process if there is anything waiting
1122 Expect_Internal (Descriptors, Result,
1123 Timeout => 0, Full_Buffer => False);
1124 Descriptor.Last_Match_End := Descriptor.Buffer_Index;
1128 Reinitialize_Buffer (Descriptor);
1132 Last := Full_Str'Last;
1134 Last := Full_Str'Last - 1;
1137 Call_Filters (Descriptor, Full_Str (Full_Str'First .. Last), Input);
1140 Write (Descriptor.Input_Fd,
1142 Last - Full_Str'First + 1);
1149 procedure Send_Signal
1150 (Descriptor : Process_Descriptor;
1154 Kill (Descriptor.Pid, Signal, 1);
1155 -- ??? Need to check process status here
1158 ---------------------------------
1159 -- Set_Up_Child_Communications --
1160 ---------------------------------
1162 procedure Set_Up_Child_Communications
1163 (Pid : in out Process_Descriptor;
1164 Pipe1 : in out Pipe_Type;
1165 Pipe2 : in out Pipe_Type;
1166 Pipe3 : in out Pipe_Type;
1168 Args : System.Address)
1170 pragma Warnings (Off, Pid);
1172 Input : File_Descriptor;
1173 Output : File_Descriptor;
1174 Error : File_Descriptor;
1177 -- Since Windows does not have a separate fork/exec, we need to
1178 -- perform the following actions:
1179 -- - save stdin, stdout, stderr
1180 -- - replace them by our pipes
1181 -- - create the child with process handle inheritance
1182 -- - revert to the previous stdin, stdout and stderr.
1184 Input := Dup (GNAT.OS_Lib.Standin);
1185 Output := Dup (GNAT.OS_Lib.Standout);
1186 Error := Dup (GNAT.OS_Lib.Standerr);
1188 -- Since we are still called from the parent process, there is no way
1189 -- currently we can cleanly close the unneeded ends of the pipes, but
1190 -- this doesn't really matter.
1191 -- We could close Pipe1.Output, Pipe2.Input, Pipe3.Input.
1193 Dup2 (Pipe1.Input, GNAT.OS_Lib.Standin);
1194 Dup2 (Pipe2.Output, GNAT.OS_Lib.Standout);
1195 Dup2 (Pipe3.Output, GNAT.OS_Lib.Standerr);
1197 Portable_Execvp (Pid.Pid'Access, Cmd & ASCII.Nul, Args);
1199 -- The following commands are not executed on Unix systems, and are
1200 -- only required for Windows systems. We are now in the parent process.
1202 -- Restore the old descriptors
1204 Dup2 (Input, GNAT.OS_Lib.Standin);
1205 Dup2 (Output, GNAT.OS_Lib.Standout);
1206 Dup2 (Error, GNAT.OS_Lib.Standerr);
1210 end Set_Up_Child_Communications;
1212 ---------------------------
1213 -- Set_Up_Communications --
1214 ---------------------------
1216 procedure Set_Up_Communications
1217 (Pid : in out Process_Descriptor;
1218 Err_To_Out : Boolean;
1219 Pipe1 : not null access Pipe_Type;
1220 Pipe2 : not null access Pipe_Type;
1221 Pipe3 : not null access Pipe_Type)
1228 if Create_Pipe (Pipe1) /= 0 then
1232 if Create_Pipe (Pipe2) /= 0 then
1236 -- Record the 'parent' end of the two pipes in Pid:
1237 -- Child stdin is connected to the 'write' end of Pipe1;
1238 -- Child stdout is connected to the 'read' end of Pipe2.
1239 -- We do not want these descriptors to remain open in the child
1240 -- process, so we mark them close-on-exec/non-inheritable.
1242 Pid.Input_Fd := Pipe1.Output;
1243 Set_Close_On_Exec (Pipe1.Output, True, Status);
1244 Pid.Output_Fd := Pipe2.Input;
1245 Set_Close_On_Exec (Pipe2.Input, True, Status);
1249 -- Reuse the standard output pipe for standard error
1251 Pipe3.all := Pipe2.all;
1254 -- Create a separate pipe for standard error
1256 if Create_Pipe (Pipe3) /= 0 then
1261 -- As above, we record the proper fd for the child's
1262 -- standard error stream.
1264 Pid.Error_Fd := Pipe3.Input;
1265 Set_Close_On_Exec (Pipe3.Input, True, Status);
1266 end Set_Up_Communications;
1268 ----------------------------------
1269 -- Set_Up_Parent_Communications --
1270 ----------------------------------
1272 procedure Set_Up_Parent_Communications
1273 (Pid : in out Process_Descriptor;
1274 Pipe1 : in out Pipe_Type;
1275 Pipe2 : in out Pipe_Type;
1276 Pipe3 : in out Pipe_Type)
1278 pragma Warnings (Off, Pid);
1280 Close (Pipe1.Input);
1281 Close (Pipe2.Output);
1282 Close (Pipe3.Output);
1283 end Set_Up_Parent_Communications;
1289 procedure Trace_Filter
1290 (Descriptor : Process_Descriptor'Class;
1292 User_Data : System.Address := System.Null_Address)
1294 pragma Warnings (Off, Descriptor);
1295 pragma Warnings (Off, User_Data);
1301 --------------------
1302 -- Unlock_Filters --
1303 --------------------
1305 procedure Unlock_Filters (Descriptor : in out Process_Descriptor) is
1307 if Descriptor.Filters_Lock > 0 then
1308 Descriptor.Filters_Lock := Descriptor.Filters_Lock - 1;