|
111
|
1 ------------------------------------------------------------------------------
|
|
|
2 -- --
|
|
|
3 -- GNAT LIBRARY COMPONENTS --
|
|
|
4 -- --
|
|
|
5 -- G N A T . E X P E C T --
|
|
|
6 -- --
|
|
|
7 -- S p e c --
|
|
|
8 -- --
|
|
131
|
9 -- Copyright (C) 2000-2018, AdaCore --
|
|
111
|
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- --
|
|
|
13 -- ware Foundation; either version 3, 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. --
|
|
|
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/>. --
|
|
|
26 -- --
|
|
|
27 -- GNAT was originally developed by the GNAT team at New York University. --
|
|
|
28 -- Extensive contributions were provided by Ada Core Technologies Inc. --
|
|
|
29 -- --
|
|
|
30 ------------------------------------------------------------------------------
|
|
|
31
|
|
|
32 -- Currently this package is implemented on all native GNAT ports. It is not
|
|
|
33 -- yet implemented for any of the cross-ports (e.g. it is not available for
|
|
|
34 -- VxWorks or LynxOS).
|
|
|
35
|
|
|
36 -- -----------
|
|
|
37 -- -- Usage --
|
|
|
38 -- -----------
|
|
|
39
|
|
|
40 -- This package provides a set of subprograms similar to what is available
|
|
|
41 -- with the standard Tcl Expect tool.
|
|
|
42
|
|
|
43 -- It allows you to easily spawn and communicate with an external process.
|
|
|
44 -- You can send commands or inputs to the process, and compare the output
|
|
|
45 -- with some expected regular expression.
|
|
|
46
|
|
|
47 -- Usage example:
|
|
|
48
|
|
|
49 -- Non_Blocking_Spawn
|
|
|
50 -- (Fd, "ftp",
|
|
|
51 -- (1 => new String' ("machine@domain")));
|
|
|
52 -- Timeout := 10_000; -- 10 seconds
|
|
|
53 -- Expect (Fd, Result, Regexp_Array'(+"\(user\)", +"\(passwd\)"),
|
|
|
54 -- Timeout);
|
|
|
55 -- case Result is
|
|
|
56 -- when 1 => Send (Fd, "my_name"); -- matched "user"
|
|
|
57 -- when 2 => Send (Fd, "my_passwd"); -- matched "passwd"
|
|
|
58 -- when Expect_Timeout => null; -- timeout
|
|
|
59 -- when others => null;
|
|
|
60 -- end case;
|
|
|
61 -- Close (Fd);
|
|
|
62
|
|
|
63 -- You can also combine multiple regular expressions together, and get the
|
|
|
64 -- specific string matching a parenthesis pair by doing something like this:
|
|
|
65 -- If you expect either "lang=optional ada" or "lang=ada" from the external
|
|
|
66 -- process, you can group the two together, which is more efficient, and
|
|
|
67 -- simply get the name of the language by doing:
|
|
|
68
|
|
|
69 -- declare
|
|
|
70 -- Matched : Match_Array (0 .. 2);
|
|
|
71 -- begin
|
|
|
72 -- Expect (Fd, Result, "lang=(optional)? ([a-z]+)", Matched);
|
|
|
73 -- Put_Line ("Seen: " &
|
|
|
74 -- Expect_Out (Fd) (Matched (2).First .. Matched (2).Last));
|
|
|
75 -- end;
|
|
|
76
|
|
|
77 -- Alternatively, you might choose to use a lower-level interface to the
|
|
|
78 -- processes, where you can give your own input and output filters every
|
|
|
79 -- time characters are read from or written to the process.
|
|
|
80
|
|
|
81 -- procedure My_Filter
|
|
|
82 -- (Descriptor : Process_Descriptor'Class;
|
|
|
83 -- Str : String;
|
|
|
84 -- User_Data : System.Address)
|
|
|
85 -- is
|
|
|
86 -- begin
|
|
|
87 -- Put_Line (Str);
|
|
|
88 -- end;
|
|
|
89
|
|
|
90 -- Non_Blocking_Spawn
|
|
|
91 -- (Fd, "tail",
|
|
|
92 -- (new String' ("-f"), new String' ("a_file")));
|
|
|
93 -- Add_Filter (Fd, My_Filter'Access, Output);
|
|
|
94 -- Expect (Fd, Result, "", 0); -- wait forever
|
|
|
95
|
|
|
96 -- The above example should probably be run in a separate task, since it is
|
|
|
97 -- blocking on the call to Expect.
|
|
|
98
|
|
|
99 -- Both examples can be combined, for instance to systematically print the
|
|
|
100 -- output seen by expect, even though you still want to let Expect do the
|
|
|
101 -- filtering. You can use the Trace_Filter subprogram for such a filter.
|
|
|
102
|
|
|
103 -- If you want to get the output of a simple command, and ignore any previous
|
|
|
104 -- existing output, it is recommended to do something like:
|
|
|
105
|
|
|
106 -- Expect (Fd, Result, ".*", Timeout => 0);
|
|
|
107 -- -- Empty the buffer, by matching everything (after checking
|
|
|
108 -- -- if there was any input).
|
|
|
109
|
|
|
110 -- Send (Fd, "command");
|
|
|
111 -- Expect (Fd, Result, ".."); -- match only on the output of command
|
|
|
112
|
|
|
113 -- -----------------
|
|
|
114 -- -- Task Safety --
|
|
|
115 -- -----------------
|
|
|
116
|
|
|
117 -- This package is not task-safe: there should not be concurrent calls to the
|
|
|
118 -- functions defined in this package. In other words, separate tasks must not
|
|
|
119 -- access the facilities of this package without synchronization that
|
|
|
120 -- serializes access.
|
|
|
121
|
|
|
122 with System;
|
|
|
123 with GNAT.OS_Lib;
|
|
|
124 with GNAT.Regpat;
|
|
|
125
|
|
|
126 package GNAT.Expect is
|
|
|
127
|
|
|
128 type Process_Id is new Integer;
|
|
|
129 Invalid_Pid : constant Process_Id := -1;
|
|
|
130 Null_Pid : constant Process_Id := 0;
|
|
|
131
|
|
|
132 type Filter_Type is (Output, Input, Died);
|
|
|
133 -- The signals that are emitted by the Process_Descriptor upon state change
|
|
|
134 -- in the child. One can connect to any of these signals through the
|
|
|
135 -- Add_Filter subprograms.
|
|
|
136 --
|
|
|
137 -- Output => Every time new characters are read from the process
|
|
|
138 -- associated with Descriptor, the filter is called with
|
|
|
139 -- these new characters in the argument.
|
|
|
140 --
|
|
|
141 -- Note that output is generated only when the program is
|
|
|
142 -- blocked in a call to Expect.
|
|
|
143 --
|
|
|
144 -- Input => Every time new characters are written to the process
|
|
|
145 -- associated with Descriptor, the filter is called with
|
|
|
146 -- these new characters in the argument.
|
|
|
147 -- Note that input is generated only by calls to Send.
|
|
|
148 --
|
|
|
149 -- Died => The child process has died, or was explicitly killed
|
|
|
150
|
|
|
151 type Process_Descriptor is tagged private;
|
|
|
152 -- Contains all the components needed to describe a process handled
|
|
|
153 -- in this package, including a process identifier, file descriptors
|
|
|
154 -- associated with the standard input, output and error, and the buffer
|
|
|
155 -- needed to handle the expect calls.
|
|
|
156
|
|
|
157 type Process_Descriptor_Access is access Process_Descriptor'Class;
|
|
|
158
|
|
|
159 ------------------------
|
|
|
160 -- Spawning a process --
|
|
|
161 ------------------------
|
|
|
162
|
|
|
163 procedure Non_Blocking_Spawn
|
|
|
164 (Descriptor : out Process_Descriptor'Class;
|
|
|
165 Command : String;
|
|
|
166 Args : GNAT.OS_Lib.Argument_List;
|
|
|
167 Buffer_Size : Natural := 4096;
|
|
|
168 Err_To_Out : Boolean := False);
|
|
|
169 -- This call spawns a new process and allows sending commands to
|
|
|
170 -- the process and/or automatic parsing of the output.
|
|
|
171 --
|
|
|
172 -- The expect buffer associated with that process can contain at most
|
|
|
173 -- Buffer_Size characters. Older characters are simply discarded when this
|
|
|
174 -- buffer is full. Beware that if the buffer is too big, this could slow
|
|
|
175 -- down the Expect calls if the output not is matched, since Expect has to
|
|
|
176 -- match all the regexp against all the characters in the buffer. If
|
|
|
177 -- Buffer_Size is 0, there is no limit (i.e. all the characters are kept
|
|
|
178 -- till Expect matches), but this is slower.
|
|
|
179 --
|
|
|
180 -- If Err_To_Out is True, then the standard error of the spawned process is
|
|
|
181 -- connected to the standard output. This is the only way to get the Expect
|
|
|
182 -- subprograms to also match on output on standard error.
|
|
|
183 --
|
|
|
184 -- Invalid_Process is raised if the process could not be spawned.
|
|
|
185 --
|
|
|
186 -- For information about spawning processes from tasking programs, see the
|
|
|
187 -- "NOTE: Spawn in tasking programs" in System.OS_Lib (s-os_lib.ads).
|
|
|
188
|
|
|
189 procedure Close (Descriptor : in out Process_Descriptor);
|
|
|
190 -- Terminate the process and close the pipes to it. It implicitly does the
|
|
|
191 -- 'wait' command required to clean up the process table. This also frees
|
|
|
192 -- the buffer associated with the process id. Raise Invalid_Process if the
|
|
|
193 -- process id is invalid.
|
|
|
194
|
|
|
195 procedure Close
|
|
|
196 (Descriptor : in out Process_Descriptor;
|
|
|
197 Status : out Integer);
|
|
|
198 -- Same as above, but also returns the exit status of the process, as set
|
|
|
199 -- for example by the procedure GNAT.OS_Lib.OS_Exit.
|
|
|
200
|
|
|
201 procedure Send_Signal
|
|
|
202 (Descriptor : Process_Descriptor;
|
|
|
203 Signal : Integer);
|
|
|
204 -- Send a given signal to the process. Raise Invalid_Process if the process
|
|
|
205 -- id is invalid.
|
|
|
206
|
|
|
207 procedure Interrupt (Descriptor : in out Process_Descriptor);
|
|
|
208 -- Interrupt the process (the equivalent of Ctrl-C on unix and windows)
|
|
|
209 -- and call close if the process dies.
|
|
|
210
|
|
|
211 function Get_Input_Fd
|
|
|
212 (Descriptor : Process_Descriptor) return GNAT.OS_Lib.File_Descriptor;
|
|
|
213 -- Return the input file descriptor associated with Descriptor
|
|
|
214
|
|
|
215 function Get_Output_Fd
|
|
|
216 (Descriptor : Process_Descriptor) return GNAT.OS_Lib.File_Descriptor;
|
|
|
217 -- Return the output file descriptor associated with Descriptor
|
|
|
218
|
|
|
219 function Get_Error_Fd
|
|
|
220 (Descriptor : Process_Descriptor) return GNAT.OS_Lib.File_Descriptor;
|
|
|
221 -- Return the error output file descriptor associated with Descriptor
|
|
|
222
|
|
|
223 function Get_Pid
|
|
|
224 (Descriptor : Process_Descriptor) return Process_Id;
|
|
|
225 -- Return the process id associated with a given process descriptor
|
|
|
226
|
|
|
227 function Get_Command_Output
|
|
|
228 (Command : String;
|
|
|
229 Arguments : GNAT.OS_Lib.Argument_List;
|
|
|
230 Input : String;
|
|
|
231 Status : not null access Integer;
|
|
|
232 Err_To_Out : Boolean := False) return String;
|
|
|
233 -- Execute Command with the specified Arguments and Input, and return the
|
|
|
234 -- generated standard output data as a single string. If Err_To_Out is
|
|
|
235 -- True, generated standard error output is included as well. On return,
|
|
|
236 -- Status is set to the command's exit status.
|
|
|
237
|
|
|
238 --------------------
|
|
|
239 -- Adding filters --
|
|
|
240 --------------------
|
|
|
241
|
|
|
242 -- This is a rather low-level interface to subprocesses, since basically
|
|
|
243 -- the filtering is left entirely to the user. See the Expect subprograms
|
|
|
244 -- below for higher level functions.
|
|
|
245
|
|
|
246 type Filter_Function is access
|
|
|
247 procedure
|
|
|
248 (Descriptor : Process_Descriptor'Class;
|
|
|
249 Str : String;
|
|
|
250 User_Data : System.Address := System.Null_Address);
|
|
|
251 -- Function called every time new characters are read from or written to
|
|
|
252 -- the process.
|
|
|
253 --
|
|
|
254 -- Str is a string of all these characters.
|
|
|
255 --
|
|
|
256 -- User_Data, if specified, is user specific data that will be passed to
|
|
|
257 -- the filter. Note that no checks are done on this parameter, so it should
|
|
|
258 -- be used with caution.
|
|
|
259
|
|
|
260 procedure Add_Filter
|
|
|
261 (Descriptor : in out Process_Descriptor;
|
|
|
262 Filter : Filter_Function;
|
|
|
263 Filter_On : Filter_Type := Output;
|
|
|
264 User_Data : System.Address := System.Null_Address;
|
|
|
265 After : Boolean := False);
|
|
|
266 -- Add a new filter for one of the filter types. This filter will be run
|
|
|
267 -- before all the existing filters, unless After is set True, in which case
|
|
|
268 -- it will be run after existing filters. User_Data is passed as is to the
|
|
|
269 -- filter procedure.
|
|
|
270
|
|
|
271 procedure Remove_Filter
|
|
|
272 (Descriptor : in out Process_Descriptor;
|
|
|
273 Filter : Filter_Function);
|
|
|
274 -- Remove a filter from the list of filters (whatever the type of the
|
|
|
275 -- filter).
|
|
|
276
|
|
|
277 procedure Trace_Filter
|
|
|
278 (Descriptor : Process_Descriptor'Class;
|
|
|
279 Str : String;
|
|
|
280 User_Data : System.Address := System.Null_Address);
|
|
|
281 -- Function that can be used as a filter and that simply outputs Str on
|
|
|
282 -- Standard_Output. This is mainly used for debugging purposes.
|
|
|
283 -- User_Data is ignored.
|
|
|
284
|
|
|
285 procedure Lock_Filters (Descriptor : in out Process_Descriptor);
|
|
|
286 -- Temporarily disables all output and input filters. They will be
|
|
|
287 -- reactivated only when Unlock_Filters has been called as many times as
|
|
|
288 -- Lock_Filters.
|
|
|
289
|
|
|
290 procedure Unlock_Filters (Descriptor : in out Process_Descriptor);
|
|
|
291 -- Unlocks the filters. They are reactivated only if Unlock_Filters
|
|
|
292 -- has been called as many times as Lock_Filters.
|
|
|
293
|
|
|
294 ------------------
|
|
|
295 -- Sending data --
|
|
|
296 ------------------
|
|
|
297
|
|
|
298 procedure Send
|
|
|
299 (Descriptor : in out Process_Descriptor;
|
|
|
300 Str : String;
|
|
|
301 Add_LF : Boolean := True;
|
|
|
302 Empty_Buffer : Boolean := False);
|
|
|
303 -- Send a string to the file descriptor.
|
|
|
304 --
|
|
|
305 -- The string is not formatted in any way, except if Add_LF is True, in
|
|
|
306 -- which case an ASCII.LF is added at the end, so that Str is recognized
|
|
|
307 -- as a command by the external process.
|
|
|
308 --
|
|
|
309 -- If Empty_Buffer is True, any input waiting from the process (or in the
|
|
|
310 -- buffer) is first discarded before the command is sent. The output
|
|
|
311 -- filters are of course called as usual.
|
|
|
312
|
|
|
313 -----------------------------------------------------------
|
|
|
314 -- Working on the output (single process, simple regexp) --
|
|
|
315 -----------------------------------------------------------
|
|
|
316
|
|
|
317 type Expect_Match is new Integer;
|
|
|
318 Expect_Full_Buffer : constant Expect_Match := -1;
|
|
|
319 -- If the buffer was full and some characters were discarded
|
|
|
320
|
|
|
321 Expect_Timeout : constant Expect_Match := -2;
|
|
|
322 -- If no output matching the regexps was found before the timeout
|
|
|
323
|
|
|
324 function "+" (S : String) return GNAT.OS_Lib.String_Access;
|
|
|
325 -- Allocate some memory for the string. This is merely a convenience
|
|
|
326 -- function to help create the array of regexps in the call to Expect.
|
|
|
327
|
|
|
328 procedure Expect
|
|
|
329 (Descriptor : in out Process_Descriptor;
|
|
|
330 Result : out Expect_Match;
|
|
|
331 Regexp : String;
|
|
|
332 Timeout : Integer := 10_000;
|
|
|
333 Full_Buffer : Boolean := False);
|
|
|
334 -- Wait till a string matching Fd can be read from Fd, and return 1 if a
|
|
|
335 -- match was found.
|
|
|
336 --
|
|
|
337 -- It consumes all the characters read from Fd until a match found, and
|
|
|
338 -- then sets the return values for the subprograms Expect_Out and
|
|
|
339 -- Expect_Out_Match.
|
|
|
340 --
|
|
|
341 -- The empty string "" will never match, and can be used if you only want
|
|
|
342 -- to match after a specific timeout. Beware that if Timeout is -1 at the
|
|
|
343 -- time, the current task will be blocked forever.
|
|
|
344 --
|
|
|
345 -- This command times out after Timeout milliseconds (or never if Timeout
|
|
|
346 -- is -1). In that case, Expect_Timeout is returned. The value returned by
|
|
|
347 -- Expect_Out and Expect_Out_Match are meaningless in that case.
|
|
|
348 --
|
|
|
349 -- Note that using a timeout of 0ms leads to unpredictable behavior, since
|
|
|
350 -- the result depends on whether the process has already sent some output
|
|
|
351 -- the first time Expect checks, and this depends on the operating system.
|
|
|
352 --
|
|
|
353 -- The regular expression must obey the syntax described in GNAT.Regpat.
|
|
|
354 --
|
|
|
355 -- If Full_Buffer is True, then Expect will match if the buffer was too
|
|
|
356 -- small and some characters were about to be discarded. In that case,
|
|
|
357 -- Expect_Full_Buffer is returned.
|
|
|
358
|
|
|
359 procedure Expect
|
|
|
360 (Descriptor : in out Process_Descriptor;
|
|
|
361 Result : out Expect_Match;
|
|
|
362 Regexp : GNAT.Regpat.Pattern_Matcher;
|
|
|
363 Timeout : Integer := 10_000;
|
|
|
364 Full_Buffer : Boolean := False);
|
|
|
365 -- Same as the previous one, but with a precompiled regular expression.
|
|
|
366 -- This is more efficient however, especially if you are using this
|
|
|
367 -- expression multiple times, since this package won't need to recompile
|
|
|
368 -- the regexp every time.
|
|
|
369
|
|
|
370 procedure Expect
|
|
|
371 (Descriptor : in out Process_Descriptor;
|
|
|
372 Result : out Expect_Match;
|
|
|
373 Regexp : String;
|
|
|
374 Matched : out GNAT.Regpat.Match_Array;
|
|
|
375 Timeout : Integer := 10_000;
|
|
|
376 Full_Buffer : Boolean := False);
|
|
|
377 -- Same as above, but it is now possible to get the indexes of the
|
|
|
378 -- substrings for the parentheses in the regexp (see the example at the
|
|
|
379 -- top of this package, as well as the documentation in the package
|
|
|
380 -- GNAT.Regpat).
|
|
|
381 --
|
|
|
382 -- Matched'First should be 0, and this index will contain the indexes for
|
|
|
383 -- the whole string that was matched. The index 1 will contain the indexes
|
|
|
384 -- for the first parentheses-pair, and so on.
|
|
|
385
|
|
|
386 ------------
|
|
|
387 -- Expect --
|
|
|
388 ------------
|
|
|
389
|
|
|
390 procedure Expect
|
|
|
391 (Descriptor : in out Process_Descriptor;
|
|
|
392 Result : out Expect_Match;
|
|
|
393 Regexp : GNAT.Regpat.Pattern_Matcher;
|
|
|
394 Matched : out GNAT.Regpat.Match_Array;
|
|
|
395 Timeout : Integer := 10_000;
|
|
|
396 Full_Buffer : Boolean := False);
|
|
|
397 -- Same as above, but with a precompiled regular expression
|
|
|
398
|
|
|
399 -------------------------------------------------------------
|
|
|
400 -- Working on the output (single process, multiple regexp) --
|
|
|
401 -------------------------------------------------------------
|
|
|
402
|
|
|
403 type Regexp_Array is array (Positive range <>) of GNAT.OS_Lib.String_Access;
|
|
|
404
|
|
|
405 type Pattern_Matcher_Access is access all GNAT.Regpat.Pattern_Matcher;
|
|
|
406 type Compiled_Regexp_Array is
|
|
|
407 array (Positive range <>) of Pattern_Matcher_Access;
|
|
|
408
|
|
|
409 function "+"
|
|
|
410 (P : GNAT.Regpat.Pattern_Matcher) return Pattern_Matcher_Access;
|
|
|
411 -- Allocate some memory for the pattern matcher. This is only a convenience
|
|
|
412 -- function to help create the array of compiled regular expressions.
|
|
|
413
|
|
|
414 procedure Expect
|
|
|
415 (Descriptor : in out Process_Descriptor;
|
|
|
416 Result : out Expect_Match;
|
|
|
417 Regexps : Regexp_Array;
|
|
|
418 Timeout : Integer := 10_000;
|
|
|
419 Full_Buffer : Boolean := False);
|
|
|
420 -- Wait till a string matching one of the regular expressions in Regexps
|
|
|
421 -- is found. This function returns the index of the regexp that matched.
|
|
|
422 -- This command is blocking, but will timeout after Timeout milliseconds.
|
|
|
423 -- In that case, Timeout is returned.
|
|
|
424
|
|
|
425 procedure Expect
|
|
|
426 (Descriptor : in out Process_Descriptor;
|
|
|
427 Result : out Expect_Match;
|
|
|
428 Regexps : Compiled_Regexp_Array;
|
|
|
429 Timeout : Integer := 10_000;
|
|
|
430 Full_Buffer : Boolean := False);
|
|
|
431 -- Same as the previous one, but with precompiled regular expressions.
|
|
|
432 -- This can be much faster if you are using them multiple times.
|
|
|
433
|
|
|
434 procedure Expect
|
|
|
435 (Descriptor : in out Process_Descriptor;
|
|
|
436 Result : out Expect_Match;
|
|
|
437 Regexps : Regexp_Array;
|
|
|
438 Matched : out GNAT.Regpat.Match_Array;
|
|
|
439 Timeout : Integer := 10_000;
|
|
|
440 Full_Buffer : Boolean := False);
|
|
|
441 -- Same as above, except that you can also access the parenthesis
|
|
|
442 -- groups inside the matching regular expression.
|
|
|
443 --
|
|
|
444 -- The first index in Matched must be 0, or Constraint_Error will be
|
|
|
445 -- raised. The index 0 contains the indexes for the whole string that was
|
|
|
446 -- matched, the index 1 contains the indexes for the first parentheses
|
|
|
447 -- pair, and so on.
|
|
|
448
|
|
|
449 procedure Expect
|
|
|
450 (Descriptor : in out Process_Descriptor;
|
|
|
451 Result : out Expect_Match;
|
|
|
452 Regexps : Compiled_Regexp_Array;
|
|
|
453 Matched : out GNAT.Regpat.Match_Array;
|
|
|
454 Timeout : Integer := 10_000;
|
|
|
455 Full_Buffer : Boolean := False);
|
|
|
456 -- Same as above, but with precompiled regular expressions. The first index
|
|
|
457 -- in Matched must be 0, or Constraint_Error will be raised.
|
|
|
458
|
|
|
459 -------------------------------------------
|
|
|
460 -- Working on the output (multi-process) --
|
|
|
461 -------------------------------------------
|
|
|
462
|
|
|
463 type Multiprocess_Regexp is record
|
|
|
464 Descriptor : Process_Descriptor_Access;
|
|
|
465 Regexp : Pattern_Matcher_Access;
|
|
|
466 end record;
|
|
|
467
|
|
|
468 type Multiprocess_Regexp_Array is
|
|
|
469 array (Positive range <>) of Multiprocess_Regexp;
|
|
|
470
|
|
|
471 procedure Free (Regexp : in out Multiprocess_Regexp);
|
|
|
472 -- Free the memory occupied by Regexp
|
|
|
473
|
|
|
474 function Has_Process (Regexp : Multiprocess_Regexp_Array) return Boolean;
|
|
|
475 -- Return True if at least one entry in Regexp is non-null, ie there is
|
|
|
476 -- still at least one process to monitor
|
|
|
477
|
|
|
478 function First_Dead_Process
|
|
|
479 (Regexp : Multiprocess_Regexp_Array) return Natural;
|
|
|
480 -- Find the first entry in Regexp that corresponds to a dead process that
|
|
|
481 -- wasn't Free-d yet. This function is called in general when Expect
|
|
|
482 -- (below) raises the exception Process_Died. This returns 0 if no process
|
|
|
483 -- has died yet.
|
|
|
484
|
|
|
485 procedure Expect
|
|
|
486 (Result : out Expect_Match;
|
|
|
487 Regexps : Multiprocess_Regexp_Array;
|
|
|
488 Matched : out GNAT.Regpat.Match_Array;
|
|
|
489 Timeout : Integer := 10_000;
|
|
|
490 Full_Buffer : Boolean := False);
|
|
|
491 -- Same as above, but for multi processes. Any of the entries in
|
|
|
492 -- Regexps can have a null Descriptor or Regexp. Such entries will
|
|
|
493 -- simply be ignored. Therefore when a process terminates, you can
|
|
|
494 -- simply reset its entry.
|
|
|
495 --
|
|
|
496 -- The expect loop would therefore look like:
|
|
|
497 --
|
|
|
498 -- Processes : Multiprocess_Regexp_Array (...) := ...;
|
|
|
499 -- R : Natural;
|
|
|
500 --
|
|
|
501 -- while Has_Process (Processes) loop
|
|
|
502 -- begin
|
|
|
503 -- Expect (Result, Processes, Timeout => -1);
|
|
|
504 -- ... process output of process Result (output, full buffer,...)
|
|
|
505 --
|
|
|
506 -- exception
|
|
|
507 -- when Process_Died =>
|
|
|
508 -- -- Free memory
|
|
|
509 -- R := First_Dead_Process (Processes);
|
|
|
510 -- Close (Processes (R).Descriptor.all, Status);
|
|
|
511 -- Free (Processes (R));
|
|
|
512 -- end;
|
|
|
513 -- end loop;
|
|
|
514
|
|
|
515 procedure Expect
|
|
|
516 (Result : out Expect_Match;
|
|
|
517 Regexps : Multiprocess_Regexp_Array;
|
|
|
518 Timeout : Integer := 10_000;
|
|
|
519 Full_Buffer : Boolean := False);
|
|
|
520 -- Same as the previous one, but for multiple processes. This procedure
|
|
|
521 -- finds the first regexp that match the associated process.
|
|
|
522
|
|
|
523 ------------------------
|
|
|
524 -- Getting the output --
|
|
|
525 ------------------------
|
|
|
526
|
|
|
527 procedure Flush
|
|
|
528 (Descriptor : in out Process_Descriptor;
|
|
|
529 Timeout : Integer := 0);
|
|
|
530 -- Discard all output waiting from the process.
|
|
|
531 --
|
|
|
532 -- This output is simply discarded, and no filter is called. This output
|
|
|
533 -- will also not be visible by the next call to Expect, nor will any output
|
|
|
534 -- currently buffered.
|
|
|
535 --
|
|
|
536 -- Timeout is the delay for which we wait for output to be available from
|
|
|
537 -- the process. If 0, we only get what is immediately available.
|
|
|
538
|
|
|
539 function Expect_Out (Descriptor : Process_Descriptor) return String;
|
|
|
540 -- Return the string matched by the last Expect call.
|
|
|
541 --
|
|
|
542 -- The returned string is in fact the concatenation of all the strings read
|
|
|
543 -- from the file descriptor up to, and including, the characters that
|
|
|
544 -- matched the regular expression.
|
|
|
545 --
|
|
|
546 -- For instance, with an input "philosophic", and a regular expression "hi"
|
|
|
547 -- in the call to expect, the strings returned the first and second time
|
|
|
548 -- would be respectively "phi" and "losophi".
|
|
|
549
|
|
|
550 function Expect_Out_Match (Descriptor : Process_Descriptor) return String;
|
|
|
551 -- Return the string matched by the last Expect call.
|
|
|
552 --
|
|
|
553 -- The returned string includes only the character that matched the
|
|
|
554 -- specific regular expression. All the characters that came before are
|
|
|
555 -- simply discarded.
|
|
|
556 --
|
|
|
557 -- For instance, with an input "philosophic", and a regular expression
|
|
|
558 -- "hi" in the call to expect, the strings returned the first and second
|
|
|
559 -- time would both be "hi".
|
|
|
560
|
|
|
561 ----------------
|
|
|
562 -- Exceptions --
|
|
|
563 ----------------
|
|
|
564
|
|
|
565 Invalid_Process : exception;
|
|
|
566 -- Raised by most subprograms above when the parameter Descriptor is not a
|
|
|
567 -- valid process or is a closed process.
|
|
|
568
|
|
|
569 Process_Died : exception;
|
|
|
570 -- Raised by all the expect subprograms if Descriptor was originally a
|
|
|
571 -- valid process that died while Expect was executing. It is also raised
|
|
|
572 -- when Expect receives an end-of-file.
|
|
|
573
|
|
|
574 private
|
|
|
575 type Filter_List_Elem;
|
|
|
576 type Filter_List is access Filter_List_Elem;
|
|
|
577 type Filter_List_Elem is record
|
|
|
578 Filter : Filter_Function;
|
|
|
579 User_Data : System.Address;
|
|
|
580 Filter_On : Filter_Type;
|
|
|
581 Next : Filter_List;
|
|
|
582 end record;
|
|
|
583
|
|
|
584 type Pipe_Type is record
|
|
|
585 Input, Output : GNAT.OS_Lib.File_Descriptor;
|
|
|
586 end record;
|
|
|
587 -- This type represents a pipe, used to communicate between two processes
|
|
|
588
|
|
|
589 procedure Set_Up_Communications
|
|
|
590 (Pid : in out Process_Descriptor;
|
|
|
591 Err_To_Out : Boolean;
|
|
|
592 Pipe1 : not null access Pipe_Type;
|
|
|
593 Pipe2 : not null access Pipe_Type;
|
|
|
594 Pipe3 : not null access Pipe_Type);
|
|
|
595 -- Set up all the communication pipes and file descriptors prior to
|
|
|
596 -- spawning the child process.
|
|
|
597
|
|
|
598 procedure Set_Up_Parent_Communications
|
|
|
599 (Pid : in out Process_Descriptor;
|
|
|
600 Pipe1 : in out Pipe_Type;
|
|
|
601 Pipe2 : in out Pipe_Type;
|
|
|
602 Pipe3 : in out Pipe_Type);
|
|
|
603 -- Finish the set up of the pipes while in the parent process
|
|
|
604
|
|
|
605 procedure Set_Up_Child_Communications
|
|
|
606 (Pid : in out Process_Descriptor;
|
|
|
607 Pipe1 : in out Pipe_Type;
|
|
|
608 Pipe2 : in out Pipe_Type;
|
|
|
609 Pipe3 : in out Pipe_Type;
|
|
|
610 Cmd : String;
|
|
|
611 Args : System.Address);
|
|
|
612 -- Finish the set up of the pipes while in the child process This also
|
|
|
613 -- spawns the child process (based on Cmd). On systems that support fork,
|
|
|
614 -- this procedure is executed inside the newly created process.
|
|
|
615
|
|
|
616 type Process_Descriptor is tagged record
|
|
|
617 Pid : aliased Process_Id := Invalid_Pid;
|
|
|
618 Input_Fd : GNAT.OS_Lib.File_Descriptor := GNAT.OS_Lib.Invalid_FD;
|
|
|
619 Output_Fd : GNAT.OS_Lib.File_Descriptor := GNAT.OS_Lib.Invalid_FD;
|
|
|
620 Error_Fd : GNAT.OS_Lib.File_Descriptor := GNAT.OS_Lib.Invalid_FD;
|
|
|
621 Filters_Lock : Integer := 0;
|
|
|
622
|
|
|
623 Filters : Filter_List := null;
|
|
|
624
|
|
|
625 Buffer : GNAT.OS_Lib.String_Access := null;
|
|
|
626 Buffer_Size : Natural := 0;
|
|
|
627 Buffer_Index : Natural := 0;
|
|
|
628
|
|
|
629 Last_Match_Start : Natural := 0;
|
|
|
630 Last_Match_End : Natural := 0;
|
|
|
631 end record;
|
|
|
632
|
|
|
633 -- The following subprogram is provided for use in the body, and also
|
|
|
634 -- possibly in future child units providing extensions to this package.
|
|
|
635
|
|
|
636 procedure Portable_Execvp
|
|
|
637 (Pid : not null access Process_Id;
|
|
|
638 Cmd : String;
|
|
|
639 Args : System.Address);
|
|
|
640 pragma Import (C, Portable_Execvp, "__gnat_expect_portable_execvp");
|
|
|
641 -- Executes, in a portable way, the command Cmd (full path must be
|
|
|
642 -- specified), with the given Args, which must be an array of string
|
|
|
643 -- pointers. Note that the first element in Args must be the executable
|
|
|
644 -- name, and the last element must be a null pointer. The returned value
|
|
|
645 -- in Pid is the process ID, or zero if not supported on the platform.
|
|
|
646
|
|
|
647 end GNAT.Expect;
|
