1 ------------------------------------------------------------------------------
3 -- GNAT LIBRARY COMPONENTS --
5 -- G N A T . E X P E C T --
9 -- Copyright (C) 2000-2007, 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 Ada.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 Ada.Unchecked_Deallocation
70 (Pattern_Matcher, Pattern_Matcher_Access);
72 procedure Free is new Ada.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) return Integer;
104 pragma Import (C, Poll, "__gnat_expect_poll");
105 -- Check whether there is any data waiting on the file descriptor
106 -- Out_fd, and wait if there is none, at most Timeout milliseconds
107 -- Returns -1 in case of error, 0 if the timeout expired before
108 -- data became available.
110 -- Out_Is_Set is set to 1 if data was available, 0 otherwise.
112 function Waitpid (Pid : Process_Id) return Integer;
113 pragma Import (C, Waitpid, "__gnat_waitpid");
114 -- Wait for a specific process id, and return its exit code
120 function "+" (S : String) return GNAT.OS_Lib.String_Access is
122 return new String'(S);
130 (P : GNAT.Regpat.Pattern_Matcher) return Pattern_Matcher_Access
133 return new GNAT.Regpat.Pattern_Matcher'(P);
141 (Descriptor : in out Process_Descriptor;
142 Filter : Filter_Function;
143 Filter_On : Filter_Type := Output;
144 User_Data : System.Address := System.Null_Address;
145 After : Boolean := False)
147 Current : Filter_List := Descriptor.Filters;
151 while Current /= null and then Current.Next /= null loop
152 Current := Current.Next;
155 if Current = null then
156 Descriptor.Filters :=
157 new Filter_List_Elem'
158 (Filter => Filter, Filter_On => Filter_On,
159 User_Data => User_Data, Next => null);
162 new Filter_List_Elem'
163 (Filter => Filter, Filter_On => Filter_On,
164 User_Data => User_Data, Next => null);
168 Descriptor.Filters :=
169 new Filter_List_Elem'
170 (Filter => Filter, Filter_On => Filter_On,
171 User_Data => User_Data, Next => Descriptor.Filters);
179 procedure Call_Filters
180 (Pid : Process_Descriptor'Class;
182 Filter_On : Filter_Type)
184 Current_Filter : Filter_List;
187 if Pid.Filters_Lock = 0 then
188 Current_Filter := Pid.Filters;
190 while Current_Filter /= null loop
191 if Current_Filter.Filter_On = Filter_On then
192 Current_Filter.Filter
193 (Pid, Str, Current_Filter.User_Data);
196 Current_Filter := Current_Filter.Next;
206 (Descriptor : in out Process_Descriptor;
207 Status : out Integer)
209 Current_Filter : Filter_List;
210 Next_Filter : Filter_List;
213 Close (Descriptor.Input_Fd);
215 if Descriptor.Error_Fd /= Descriptor.Output_Fd then
216 Close (Descriptor.Error_Fd);
219 Close (Descriptor.Output_Fd);
221 -- ??? Should have timeouts for different signals
223 if Descriptor.Pid > 0 then -- see comment in Send_Signal
224 Kill (Descriptor.Pid, Sig_Num => 9, Close => 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;
240 -- Check process id (see comment in Send_Signal)
242 if Descriptor.Pid > 0 then
243 Status := Waitpid (Descriptor.Pid);
245 raise Invalid_Process;
249 procedure Close (Descriptor : in out Process_Descriptor) is
252 Close (Descriptor, Status);
260 (Descriptor : in out Process_Descriptor;
261 Result : out Expect_Match;
263 Timeout : Integer := 10000;
264 Full_Buffer : Boolean := False)
268 Expect (Descriptor, Result, Never_Match, Timeout, Full_Buffer);
270 Expect (Descriptor, Result, Compile (Regexp), Timeout, Full_Buffer);
275 (Descriptor : in out Process_Descriptor;
276 Result : out Expect_Match;
278 Matched : out GNAT.Regpat.Match_Array;
279 Timeout : Integer := 10000;
280 Full_Buffer : Boolean := False)
283 pragma Assert (Matched'First = 0);
286 (Descriptor, Result, Never_Match, Matched, Timeout, Full_Buffer);
289 (Descriptor, Result, Compile (Regexp), Matched, Timeout,
295 (Descriptor : in out Process_Descriptor;
296 Result : out Expect_Match;
297 Regexp : GNAT.Regpat.Pattern_Matcher;
298 Timeout : Integer := 10000;
299 Full_Buffer : Boolean := False)
301 Matched : GNAT.Regpat.Match_Array (0 .. 0);
304 Expect (Descriptor, Result, Regexp, Matched, Timeout, Full_Buffer);
308 (Descriptor : in out Process_Descriptor;
309 Result : out Expect_Match;
310 Regexp : GNAT.Regpat.Pattern_Matcher;
311 Matched : out GNAT.Regpat.Match_Array;
312 Timeout : Integer := 10000;
313 Full_Buffer : Boolean := False)
316 Descriptors : Array_Of_Pd := (1 => Descriptor'Unrestricted_Access);
317 Try_Until : constant Time := Clock + Duration (Timeout) / 1000.0;
318 Timeout_Tmp : Integer := Timeout;
321 pragma Assert (Matched'First = 0);
322 Reinitialize_Buffer (Descriptor);
325 -- First, test if what is already in the buffer matches (This is
326 -- required if this package is used in multi-task mode, since one of
327 -- the tasks might have added something in the buffer, and we don't
328 -- want other tasks to wait for new input to be available before
329 -- checking the regexps).
332 (Regexp, Descriptor.Buffer (1 .. Descriptor.Buffer_Index), Matched);
334 if Descriptor.Buffer_Index >= 1 and then Matched (0).First /= 0 then
336 Descriptor.Last_Match_Start := Matched (0).First;
337 Descriptor.Last_Match_End := Matched (0).Last;
341 -- Else try to read new input
343 Expect_Internal (Descriptors, N, Timeout_Tmp, Full_Buffer);
345 if N = Expect_Timeout or else N = Expect_Full_Buffer then
350 -- Calculate the timeout for the next turn
352 -- Note that Timeout is, from the caller's perspective, the maximum
353 -- time until a match, not the maximum time until some output is
354 -- read, and thus cannot be reused as is for Expect_Internal.
356 if Timeout /= -1 then
357 Timeout_Tmp := Integer (Try_Until - Clock) * 1000;
359 if Timeout_Tmp < 0 then
360 Result := Expect_Timeout;
366 -- Even if we had the general timeout above, we have to test that the
367 -- last test we read from the external process didn't match.
370 (Regexp, Descriptor.Buffer (1 .. Descriptor.Buffer_Index), Matched);
372 if Matched (0).First /= 0 then
374 Descriptor.Last_Match_Start := Matched (0).First;
375 Descriptor.Last_Match_End := Matched (0).Last;
381 (Descriptor : in out Process_Descriptor;
382 Result : out Expect_Match;
383 Regexps : Regexp_Array;
384 Timeout : Integer := 10000;
385 Full_Buffer : Boolean := False)
387 Patterns : Compiled_Regexp_Array (Regexps'Range);
388 Matched : GNAT.Regpat.Match_Array (0 .. 0);
391 for J in Regexps'Range loop
392 Patterns (J) := new Pattern_Matcher'(Compile (Regexps (J).all));
395 Expect (Descriptor, Result, Patterns, Matched, Timeout, Full_Buffer);
397 for J in Regexps'Range loop
403 (Descriptor : in out Process_Descriptor;
404 Result : out Expect_Match;
405 Regexps : Compiled_Regexp_Array;
406 Timeout : Integer := 10000;
407 Full_Buffer : Boolean := False)
409 Matched : GNAT.Regpat.Match_Array (0 .. 0);
412 Expect (Descriptor, Result, Regexps, Matched, Timeout, Full_Buffer);
416 (Result : out Expect_Match;
417 Regexps : Multiprocess_Regexp_Array;
418 Timeout : Integer := 10000;
419 Full_Buffer : Boolean := False)
421 Matched : GNAT.Regpat.Match_Array (0 .. 0);
424 Expect (Result, Regexps, Matched, Timeout, Full_Buffer);
428 (Descriptor : in out Process_Descriptor;
429 Result : out Expect_Match;
430 Regexps : Regexp_Array;
431 Matched : out GNAT.Regpat.Match_Array;
432 Timeout : Integer := 10000;
433 Full_Buffer : Boolean := False)
435 Patterns : Compiled_Regexp_Array (Regexps'Range);
438 pragma Assert (Matched'First = 0);
440 for J in Regexps'Range loop
441 Patterns (J) := new Pattern_Matcher'(Compile (Regexps (J).all));
444 Expect (Descriptor, Result, Patterns, Matched, Timeout, Full_Buffer);
446 for J in Regexps'Range loop
452 (Descriptor : in out Process_Descriptor;
453 Result : out Expect_Match;
454 Regexps : Compiled_Regexp_Array;
455 Matched : out GNAT.Regpat.Match_Array;
456 Timeout : Integer := 10000;
457 Full_Buffer : Boolean := False)
460 Descriptors : Array_Of_Pd := (1 => Descriptor'Unrestricted_Access);
463 pragma Assert (Matched'First = 0);
465 Reinitialize_Buffer (Descriptor);
468 -- First, test if what is already in the buffer matches (This is
469 -- required if this package is used in multi-task mode, since one of
470 -- the tasks might have added something in the buffer, and we don't
471 -- want other tasks to wait for new input to be available before
472 -- checking the regexps).
474 if Descriptor.Buffer /= null then
475 for J in Regexps'Range loop
478 Descriptor.Buffer (1 .. Descriptor.Buffer_Index),
481 if Matched (0) /= No_Match then
482 Result := Expect_Match (J);
483 Descriptor.Last_Match_Start := Matched (0).First;
484 Descriptor.Last_Match_End := Matched (0).Last;
490 Expect_Internal (Descriptors, N, Timeout, Full_Buffer);
492 if N = Expect_Timeout or else N = Expect_Full_Buffer then
500 (Result : out Expect_Match;
501 Regexps : Multiprocess_Regexp_Array;
502 Matched : out GNAT.Regpat.Match_Array;
503 Timeout : Integer := 10000;
504 Full_Buffer : Boolean := False)
507 Descriptors : Array_Of_Pd (Regexps'Range);
510 pragma Assert (Matched'First = 0);
512 for J in Descriptors'Range loop
513 Descriptors (J) := Regexps (J).Descriptor;
514 Reinitialize_Buffer (Regexps (J).Descriptor.all);
518 -- First, test if what is already in the buffer matches (This is
519 -- required if this package is used in multi-task mode, since one of
520 -- the tasks might have added something in the buffer, and we don't
521 -- want other tasks to wait for new input to be available before
522 -- checking the regexps).
524 for J in Regexps'Range loop
525 Match (Regexps (J).Regexp.all,
526 Regexps (J).Descriptor.Buffer
527 (1 .. Regexps (J).Descriptor.Buffer_Index),
530 if Matched (0) /= No_Match then
531 Result := Expect_Match (J);
532 Regexps (J).Descriptor.Last_Match_Start := Matched (0).First;
533 Regexps (J).Descriptor.Last_Match_End := Matched (0).Last;
538 Expect_Internal (Descriptors, N, Timeout, Full_Buffer);
540 if N = Expect_Timeout or else N = Expect_Full_Buffer then
547 ---------------------
548 -- Expect_Internal --
549 ---------------------
551 procedure Expect_Internal
552 (Descriptors : in out Array_Of_Pd;
553 Result : out Expect_Match;
555 Full_Buffer : Boolean)
557 Num_Descriptors : Integer;
558 Buffer_Size : Integer := 0;
562 type File_Descriptor_Array is
563 array (Descriptors'Range) of File_Descriptor;
564 Fds : aliased File_Descriptor_Array;
566 type Integer_Array is array (Descriptors'Range) of Integer;
567 Is_Set : aliased Integer_Array;
570 for J in Descriptors'Range loop
571 Fds (J) := Descriptors (J).Output_Fd;
573 if Descriptors (J).Buffer_Size = 0 then
574 Buffer_Size := Integer'Max (Buffer_Size, 4096);
577 Integer'Max (Buffer_Size, Descriptors (J).Buffer_Size);
582 Buffer : aliased String (1 .. Buffer_Size);
583 -- Buffer used for input. This is allocated only once, not for
584 -- every iteration of the loop
587 -- Loop until we match or we have a timeout
591 Poll (Fds'Address, Fds'Length, Timeout, Is_Set'Address);
593 case Num_Descriptors is
603 Result := Expect_Timeout;
609 for J in Descriptors'Range loop
610 if Is_Set (J) = 1 then
611 Buffer_Size := Descriptors (J).Buffer_Size;
613 if Buffer_Size = 0 then
617 N := Read (Descriptors (J).Output_Fd, Buffer'Address,
620 -- Error or End of file
623 -- ??? Note that ddd tries again up to three times
624 -- in that case. See LiterateA.C:174
628 -- If there is no limit to the buffer size
630 if Descriptors (J).Buffer_Size = 0 then
633 Tmp : String_Access := Descriptors (J).Buffer;
637 Descriptors (J).Buffer :=
638 new String (1 .. Tmp'Length + N);
639 Descriptors (J).Buffer (1 .. Tmp'Length) :=
641 Descriptors (J).Buffer
642 (Tmp'Length + 1 .. Tmp'Length + N) :=
645 Descriptors (J).Buffer_Index :=
646 Descriptors (J).Buffer'Last;
649 Descriptors (J).Buffer :=
651 Descriptors (J).Buffer.all :=
653 Descriptors (J).Buffer_Index := N;
658 -- Add what we read to the buffer
660 if Descriptors (J).Buffer_Index + N - 1 >
661 Descriptors (J).Buffer_Size
663 -- If the user wants to know when we have
664 -- read more than the buffer can contain.
667 Result := Expect_Full_Buffer;
671 -- Keep as much as possible from the buffer,
672 -- and forget old characters.
674 Descriptors (J).Buffer
675 (1 .. Descriptors (J).Buffer_Size - N) :=
676 Descriptors (J).Buffer
677 (N - Descriptors (J).Buffer_Size +
678 Descriptors (J).Buffer_Index + 1 ..
679 Descriptors (J).Buffer_Index);
680 Descriptors (J).Buffer_Index :=
681 Descriptors (J).Buffer_Size - N;
684 -- Keep what we read in the buffer
686 Descriptors (J).Buffer
687 (Descriptors (J).Buffer_Index + 1 ..
688 Descriptors (J).Buffer_Index + N) :=
690 Descriptors (J).Buffer_Index :=
691 Descriptors (J).Buffer_Index + N;
694 -- Call each of the output filter with what we
698 (Descriptors (J).all, Buffer (1 .. N), Output);
700 Result := Expect_Match (N);
714 function Expect_Out (Descriptor : Process_Descriptor) return String is
716 return Descriptor.Buffer (1 .. Descriptor.Last_Match_End);
719 ----------------------
720 -- Expect_Out_Match --
721 ----------------------
723 function Expect_Out_Match (Descriptor : Process_Descriptor) return String is
725 return Descriptor.Buffer
726 (Descriptor.Last_Match_Start .. Descriptor.Last_Match_End);
727 end Expect_Out_Match;
734 (Descriptor : in out Process_Descriptor;
735 Timeout : Integer := 0)
737 Buffer_Size : constant Integer := 8192;
738 Num_Descriptors : Integer;
740 Is_Set : aliased Integer;
741 Buffer : aliased String (1 .. Buffer_Size);
744 -- Empty the current buffer
746 Descriptor.Last_Match_End := Descriptor.Buffer_Index;
747 Reinitialize_Buffer (Descriptor);
749 -- Read everything from the process to flush its output
753 Poll (Descriptor.Output_Fd'Address, 1, Timeout, Is_Set'Address);
755 case Num_Descriptors is
762 -- Timeout => End of flush
771 N := Read (Descriptor.Output_Fd, Buffer'Address,
784 ------------------------
785 -- Get_Command_Output --
786 ------------------------
788 function Get_Command_Output
790 Arguments : GNAT.OS_Lib.Argument_List;
792 Status : not null access Integer;
793 Err_To_Out : Boolean := False) return String
797 Process : Process_Descriptor;
799 Output : String_Access := new String (1 .. 1024);
800 -- Buffer used to accumulate standard output from the launched
801 -- command, expanded as necessary during execution.
804 -- Index of the last used character within Output
808 (Process, Command, Arguments, Err_To_Out => Err_To_Out);
810 if Input'Length > 0 then
811 Send (Process, Input);
814 GNAT.OS_Lib.Close (Get_Input_Fd (Process));
817 Result : Expect_Match;
820 -- This loop runs until the call to Expect raises Process_Died
823 Expect (Process, Result, ".+");
826 NOutput : String_Access;
827 S : constant String := Expect_Out (Process);
828 pragma Assert (S'Length > 0);
831 -- Expand buffer if we need more space. Note here that we add
832 -- S'Length to ensure that S will fit in the new buffer size.
834 if Last + S'Length > Output'Last then
835 NOutput := new String (1 .. 2 * Output'Last + S'Length);
836 NOutput (Output'Range) := Output.all;
839 -- Here if current buffer size is OK
845 NOutput (Last + 1 .. Last + S'Length) := S;
846 Last := Last + S'Length;
853 Close (Process, Status.all);
861 S : constant String := Output (1 .. Last);
866 end Get_Command_Output;
872 function Get_Error_Fd
873 (Descriptor : Process_Descriptor) return GNAT.OS_Lib.File_Descriptor
876 return Descriptor.Error_Fd;
883 function Get_Input_Fd
884 (Descriptor : Process_Descriptor) return GNAT.OS_Lib.File_Descriptor
887 return Descriptor.Input_Fd;
894 function Get_Output_Fd
895 (Descriptor : Process_Descriptor) return GNAT.OS_Lib.File_Descriptor
898 return Descriptor.Output_Fd;
906 (Descriptor : Process_Descriptor) return Process_Id
909 return Descriptor.Pid;
916 procedure Interrupt (Descriptor : in out Process_Descriptor) is
917 SIGINT : constant := 2;
919 Send_Signal (Descriptor, SIGINT);
926 procedure Lock_Filters (Descriptor : in out Process_Descriptor) is
928 Descriptor.Filters_Lock := Descriptor.Filters_Lock + 1;
931 ------------------------
932 -- Non_Blocking_Spawn --
933 ------------------------
935 procedure Non_Blocking_Spawn
936 (Descriptor : out Process_Descriptor'Class;
938 Args : GNAT.OS_Lib.Argument_List;
939 Buffer_Size : Natural := 4096;
940 Err_To_Out : Boolean := False)
942 function Fork return Process_Id;
943 pragma Import (C, Fork, "__gnat_expect_fork");
944 -- Starts a new process if possible. See the Unix command fork for more
945 -- information. On systems that do not support this capability (such as
946 -- Windows...), this command does nothing, and Fork will return
949 Pipe1, Pipe2, Pipe3 : aliased Pipe_Type;
952 Arg_List : String_List (1 .. Args'Length + 2);
953 C_Arg_List : aliased array (1 .. Args'Length + 2) of System.Address;
955 Command_With_Path : String_Access;
958 -- Create the rest of the pipes
960 Set_Up_Communications
961 (Descriptor, Err_To_Out, Pipe1'Access, Pipe2'Access, Pipe3'Access);
963 Command_With_Path := Locate_Exec_On_Path (Command);
965 if Command_With_Path = null then
966 raise Invalid_Process;
969 -- Fork a new process
971 Descriptor.Pid := Fork;
973 -- Are we now in the child (or, for Windows, still in the common
976 if Descriptor.Pid = Null_Pid then
977 -- Prepare an array of arguments to pass to C
979 Arg := new String (1 .. Command_With_Path'Length + 1);
980 Arg (1 .. Command_With_Path'Length) := Command_With_Path.all;
981 Arg (Arg'Last) := ASCII.NUL;
984 for J in Args'Range loop
985 Arg := new String (1 .. Args (J)'Length + 1);
986 Arg (1 .. Args (J)'Length) := Args (J).all;
987 Arg (Arg'Last) := ASCII.NUL;
988 Arg_List (J + 2 - Args'First) := Arg.all'Access;
991 Arg_List (Arg_List'Last) := null;
993 -- Make sure all arguments are compatible with OS conventions
995 Normalize_Arguments (Arg_List);
997 -- Prepare low-level argument list from the normalized arguments
999 for K in Arg_List'Range loop
1000 if Arg_List (K) /= null then
1001 C_Arg_List (K) := Arg_List (K).all'Address;
1003 C_Arg_List (K) := System.Null_Address;
1007 -- This does not return on Unix systems
1009 Set_Up_Child_Communications
1010 (Descriptor, Pipe1, Pipe2, Pipe3, Command_With_Path.all,
1011 C_Arg_List'Address);
1014 Free (Command_With_Path);
1016 -- Did we have an error when spawning the child ?
1018 if Descriptor.Pid < Null_Pid then
1019 raise Invalid_Process;
1021 -- We are now in the parent process
1023 Set_Up_Parent_Communications (Descriptor, Pipe1, Pipe2, Pipe3);
1026 -- Create the buffer
1028 Descriptor.Buffer_Size := Buffer_Size;
1030 if Buffer_Size /= 0 then
1031 Descriptor.Buffer := new String (1 .. Positive (Buffer_Size));
1034 -- Initialize the filters
1036 Descriptor.Filters := null;
1037 end Non_Blocking_Spawn;
1039 -------------------------
1040 -- Reinitialize_Buffer --
1041 -------------------------
1043 procedure Reinitialize_Buffer
1044 (Descriptor : in out Process_Descriptor'Class)
1047 if Descriptor.Buffer_Size = 0 then
1049 Tmp : String_Access := Descriptor.Buffer;
1052 Descriptor.Buffer :=
1054 (1 .. Descriptor.Buffer_Index - Descriptor.Last_Match_End);
1057 Descriptor.Buffer.all := Tmp
1058 (Descriptor.Last_Match_End + 1 .. Descriptor.Buffer_Index);
1063 Descriptor.Buffer_Index := Descriptor.Buffer'Last;
1067 (1 .. Descriptor.Buffer_Index - Descriptor.Last_Match_End) :=
1069 (Descriptor.Last_Match_End + 1 .. Descriptor.Buffer_Index);
1071 if Descriptor.Buffer_Index > Descriptor.Last_Match_End then
1072 Descriptor.Buffer_Index :=
1073 Descriptor.Buffer_Index - Descriptor.Last_Match_End;
1075 Descriptor.Buffer_Index := 0;
1079 Descriptor.Last_Match_Start := 0;
1080 Descriptor.Last_Match_End := 0;
1081 end Reinitialize_Buffer;
1087 procedure Remove_Filter
1088 (Descriptor : in out Process_Descriptor;
1089 Filter : Filter_Function)
1091 Previous : Filter_List := null;
1092 Current : Filter_List := Descriptor.Filters;
1095 while Current /= null loop
1096 if Current.Filter = Filter then
1097 if Previous = null then
1098 Descriptor.Filters := Current.Next;
1100 Previous.Next := Current.Next;
1104 Previous := Current;
1105 Current := Current.Next;
1114 (Descriptor : in out Process_Descriptor;
1116 Add_LF : Boolean := True;
1117 Empty_Buffer : Boolean := False)
1119 Line_Feed : aliased constant String := (1 .. 1 => ASCII.LF);
1120 Result : Expect_Match;
1121 Descriptors : Array_Of_Pd := (1 => Descriptor'Unrestricted_Access);
1124 pragma Warnings (Off, Discard);
1127 if Empty_Buffer then
1129 -- Force a read on the process if there is anything waiting
1132 (Descriptors, Result, Timeout => 0, Full_Buffer => False);
1133 Descriptor.Last_Match_End := Descriptor.Buffer_Index;
1137 Reinitialize_Buffer (Descriptor);
1140 Call_Filters (Descriptor, Str, Input);
1142 Write (Descriptor.Input_Fd, Str'Address, Str'Last - Str'First + 1);
1145 Call_Filters (Descriptor, Line_Feed, Input);
1147 Write (Descriptor.Input_Fd, Line_Feed'Address, 1);
1155 procedure Send_Signal
1156 (Descriptor : Process_Descriptor;
1160 -- A nonpositive process id passed to kill has special meanings. For
1161 -- example, -1 means kill all processes in sight, including self, in
1162 -- POSIX and Windows (and something slightly different in Linux). See
1163 -- man pages for details. In any case, we don't want to do that. Note
1164 -- that Descriptor.Pid will be -1 if the process was not successfully
1165 -- started; we don't want to kill ourself in that case.
1167 if Descriptor.Pid > 0 then
1168 Kill (Descriptor.Pid, Signal, Close => 1);
1169 -- ??? Need to check process status here
1171 raise Invalid_Process;
1175 ---------------------------------
1176 -- Set_Up_Child_Communications --
1177 ---------------------------------
1179 procedure Set_Up_Child_Communications
1180 (Pid : in out Process_Descriptor;
1181 Pipe1 : in out Pipe_Type;
1182 Pipe2 : in out Pipe_Type;
1183 Pipe3 : in out Pipe_Type;
1185 Args : System.Address)
1187 pragma Warnings (Off, Pid);
1189 Input : File_Descriptor;
1190 Output : File_Descriptor;
1191 Error : File_Descriptor;
1194 -- Since Windows does not have a separate fork/exec, we need to
1195 -- perform the following actions:
1196 -- - save stdin, stdout, stderr
1197 -- - replace them by our pipes
1198 -- - create the child with process handle inheritance
1199 -- - revert to the previous stdin, stdout and stderr.
1201 Input := Dup (GNAT.OS_Lib.Standin);
1202 Output := Dup (GNAT.OS_Lib.Standout);
1203 Error := Dup (GNAT.OS_Lib.Standerr);
1205 -- Since we are still called from the parent process, there is no way
1206 -- currently we can cleanly close the unneeded ends of the pipes, but
1207 -- this doesn't really matter.
1208 -- We could close Pipe1.Output, Pipe2.Input, Pipe3.Input.
1210 Dup2 (Pipe1.Input, GNAT.OS_Lib.Standin);
1211 Dup2 (Pipe2.Output, GNAT.OS_Lib.Standout);
1212 Dup2 (Pipe3.Output, GNAT.OS_Lib.Standerr);
1214 Portable_Execvp (Pid.Pid'Access, Cmd & ASCII.Nul, Args);
1216 -- The following commands are not executed on Unix systems, and are
1217 -- only required for Windows systems. We are now in the parent process.
1219 -- Restore the old descriptors
1221 Dup2 (Input, GNAT.OS_Lib.Standin);
1222 Dup2 (Output, GNAT.OS_Lib.Standout);
1223 Dup2 (Error, GNAT.OS_Lib.Standerr);
1227 end Set_Up_Child_Communications;
1229 ---------------------------
1230 -- Set_Up_Communications --
1231 ---------------------------
1233 procedure Set_Up_Communications
1234 (Pid : in out Process_Descriptor;
1235 Err_To_Out : Boolean;
1236 Pipe1 : not null access Pipe_Type;
1237 Pipe2 : not null access Pipe_Type;
1238 Pipe3 : not null access Pipe_Type)
1245 if Create_Pipe (Pipe1) /= 0 then
1249 if Create_Pipe (Pipe2) /= 0 then
1253 -- Record the 'parent' end of the two pipes in Pid:
1254 -- Child stdin is connected to the 'write' end of Pipe1;
1255 -- Child stdout is connected to the 'read' end of Pipe2.
1256 -- We do not want these descriptors to remain open in the child
1257 -- process, so we mark them close-on-exec/non-inheritable.
1259 Pid.Input_Fd := Pipe1.Output;
1260 Set_Close_On_Exec (Pipe1.Output, True, Status);
1261 Pid.Output_Fd := Pipe2.Input;
1262 Set_Close_On_Exec (Pipe2.Input, True, Status);
1266 -- Reuse the standard output pipe for standard error
1268 Pipe3.all := Pipe2.all;
1271 -- Create a separate pipe for standard error
1273 if Create_Pipe (Pipe3) /= 0 then
1278 -- As above, record the proper fd for the child's standard error stream
1280 Pid.Error_Fd := Pipe3.Input;
1281 Set_Close_On_Exec (Pipe3.Input, True, Status);
1282 end Set_Up_Communications;
1284 ----------------------------------
1285 -- Set_Up_Parent_Communications --
1286 ----------------------------------
1288 procedure Set_Up_Parent_Communications
1289 (Pid : in out Process_Descriptor;
1290 Pipe1 : in out Pipe_Type;
1291 Pipe2 : in out Pipe_Type;
1292 Pipe3 : in out Pipe_Type)
1294 pragma Warnings (Off, Pid);
1296 Close (Pipe1.Input);
1297 Close (Pipe2.Output);
1298 Close (Pipe3.Output);
1299 end Set_Up_Parent_Communications;
1305 procedure Trace_Filter
1306 (Descriptor : Process_Descriptor'Class;
1308 User_Data : System.Address := System.Null_Address)
1310 pragma Warnings (Off, Descriptor);
1311 pragma Warnings (Off, User_Data);
1316 --------------------
1317 -- Unlock_Filters --
1318 --------------------
1320 procedure Unlock_Filters (Descriptor : in out Process_Descriptor) is
1322 if Descriptor.Filters_Lock > 0 then
1323 Descriptor.Filters_Lock := Descriptor.Filters_Lock - 1;