OSDN Git Service

* 1aexcept.adb, 1aexcept.ads, 1ic.ads, 1ssecsta.adb,
[pf3gnuchains/gcc-fork.git] / gcc / ada / g-expect.ads
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 --                                                                          --
9 --           Copyright (C) 2000-2002 Ada Core Technologies, Inc.            --
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 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,  59 Temple Place - Suite 330,  Boston, --
20 -- MA 02111-1307, USA.                                                      --
21 --                                                                          --
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.                                      --
28 --                                                                          --
29 -- GNAT is maintained by Ada Core Technologies Inc (http://www.gnat.com).   --
30 --                                                                          --
31 ------------------------------------------------------------------------------
32
33 --  Currently this package is implemented on all native GNAT ports except
34 --  for VMS. It is not yet implemented for any of the cross-ports (e.g. it
35 --  is not available for VxWorks or LynxOS).
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@domaine")));
52 --      Timeout := 10000;  --  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. If you
65 --  expect either "lang=optional ada" or "lang=ada" from the external process,
66 --  you can group the two together, which is more efficient, and simply get the
67 --  name of the language by doing:
68 --
69 --      declare
70 --         Matched : Regexp_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 --  Task Safety
114 --  ===========
115 --
116 --  This package is not task-safe. However, you can easily make is task safe
117 --  by encapsulating the type Process_Descriptor in a protected record.
118 --  There should not be concurrent calls to Expect.
119
120 with System;
121 with GNAT.OS_Lib;
122 with GNAT.Regpat;
123
124 package GNAT.Expect is
125
126    type Process_Id is new Integer;
127    Invalid_Pid : constant Process_Id := -1;
128    Null_Pid    : constant Process_Id := 0;
129
130    type Filter_Type is (Output, Input, Died);
131    --  The signals that are emitted by the Process_Descriptor upon state
132    --  changed in the child. One can connect to any of this signal through
133    --  the Add_Filter subprograms.
134    --
135    --     Output => Every time new characters are read from the process
136    --               associated with Descriptor, the filter is called with
137    --               these new characters in argument.
138    --
139    --               Note that output is only generated when the program is
140    --               blocked in a call to Expect.
141    --
142    --     Input  => Every time new characters are written to the process
143    --               associated with Descriptor, the filter is called with
144    --               these new characters in argument.
145    --               Note that input is only generated by calls to Send.
146    --
147    --     Died   => The child process has died, or was explicitly killed
148
149    type Process_Descriptor is tagged private;
150    --  Contains all the components needed to describe a process handled
151    --  in this package, including a process identifier, file descriptors
152    --  associated with the standard input, output and error, and the buffer
153    --  needed to handle the expect calls.
154
155    type Process_Descriptor_Access is access Process_Descriptor'Class;
156
157    ------------------------
158    -- Spawning a process --
159    ------------------------
160
161    procedure Non_Blocking_Spawn
162      (Descriptor  : out Process_Descriptor'Class;
163       Command     : String;
164       Args        : GNAT.OS_Lib.Argument_List;
165       Buffer_Size : Natural := 4096;
166       Err_To_Out  : Boolean := False);
167    --  This call spawns a new process and allows sending commands to
168    --  the process and/or automatic parsing of the output.
169    --
170    --  The expect buffer associated with that process can contain at most
171    --  Buffer_Size characters. Older characters are simply discarded when
172    --  this buffer is full. Beware that if the buffer is too big, this could
173    --  slow down the Expect calls if not output is matched, since Expect has
174    --  to match all the regexp against all the characters in the buffer.
175    --  If Buffer_Size is 0, there is no limit (ie all the characters are kept
176    --  till Expect matches), but this is slower.
177    --
178    --  If Err_To_Out is True, then the standard error of the spawned process is
179    --  connected to the standard output. This is the only way to get the
180    --  Except subprograms also match on output on standard error.
181    --
182    --  Invalid_Process is raised if the process could not be spawned.
183
184    procedure Close (Descriptor : in out Process_Descriptor);
185    --  Terminate the process and close the pipes to it. It implicitly
186    --  does the 'wait' command required to clean up the process table.
187    --  This also frees the buffer associated with the process id.
188
189    procedure Close
190      (Descriptor : in out Process_Descriptor;
191       Status     : out Integer);
192    --  Same as above, but also returns the exit status of the process,
193    --  as set for example by the procedure GNAT.OS_Lib.OS_Exit.
194
195    procedure Send_Signal
196      (Descriptor : Process_Descriptor;
197       Signal     : Integer);
198    --  Send a given signal to the process.
199
200    procedure Interrupt (Descriptor : in out Process_Descriptor);
201    --  Interrupt the process (the equivalent of Ctrl-C on unix and windows)
202    --  and call close if the process dies.
203
204    function Get_Input_Fd
205      (Descriptor : Process_Descriptor)
206       return       GNAT.OS_Lib.File_Descriptor;
207    --  Return the input file descriptor associated with Descriptor.
208
209    function Get_Output_Fd
210      (Descriptor : Process_Descriptor)
211       return       GNAT.OS_Lib.File_Descriptor;
212    --  Return the output file descriptor associated with Descriptor.
213
214    function Get_Error_Fd
215      (Descriptor : Process_Descriptor)
216       return       GNAT.OS_Lib.File_Descriptor;
217    --  Return the error output file descriptor associated with Descriptor.
218
219    function Get_Pid
220      (Descriptor : Process_Descriptor)
221       return       Process_Id;
222    --  Return the process id associated with a given process descriptor.
223
224    --------------------
225    -- Adding filters --
226    --------------------
227
228    --  This is a rather low-level interface to subprocesses, since basically
229    --  the filtering is left entirely to the user. See the Expect subprograms
230    --  below for higher level functions.
231
232    type Filter_Function is access
233      procedure
234        (Descriptor : Process_Descriptor'Class;
235         Str        : String;
236         User_Data  : System.Address := System.Null_Address);
237    --  Function called every time new characters are read from or written
238    --  to the process.
239    --
240    --  Str is a string of all these characters.
241    --
242    --  User_Data, if specified, is a user specific data that will be passed to
243    --  the filter. Note that no checks are done on this parameter that should
244    --  be used with cautiousness.
245
246    procedure Add_Filter
247      (Descriptor : in out Process_Descriptor;
248       Filter     : Filter_Function;
249       Filter_On  : Filter_Type := Output;
250       User_Data  : System.Address := System.Null_Address;
251       After      : Boolean := False);
252    --  Add a new filter for one of the filter type. This filter will be
253    --  run before all the existing filters, unless After is set True,
254    --  in which case it will be run after existing filters. User_Data
255    --  is passed as is to the filter procedure.
256
257    procedure Remove_Filter
258      (Descriptor : in out Process_Descriptor;
259       Filter     : Filter_Function);
260    --  Remove a filter from the list of filters (whatever the type of the
261    --  filter).
262
263    procedure Trace_Filter
264      (Descriptor : Process_Descriptor'Class;
265       Str        : String;
266       User_Data  : System.Address := System.Null_Address);
267    --  Function that can be used a filter and that simply outputs Str on
268    --  Standard_Output. This is mainly used for debugging purposes.
269    --  User_Data is ignored.
270
271    procedure Lock_Filters (Descriptor : in out Process_Descriptor);
272    --  Temporarily disables all output and input filters. They will be
273    --  reactivated only when Unlock_Filters has been called as many times as
274    --  Lock_Filters;
275
276    procedure Unlock_Filters (Descriptor : in out Process_Descriptor);
277    --  Unlocks the filters. They are reactivated only if Unlock_Filters
278    --  has been called as many times as Lock_Filters.
279
280    ------------------
281    -- Sending data --
282    ------------------
283
284    procedure Send
285      (Descriptor   : in out Process_Descriptor;
286       Str          : String;
287       Add_LF       : Boolean := True;
288       Empty_Buffer : Boolean := False);
289    --  Send a string to the file descriptor.
290    --
291    --  The string is not formatted in any way, except if Add_LF is True,
292    --  in which case an ASCII.LF is added at the end, so that Str is
293    --  recognized as a command by the external process.
294    --
295    --  If Empty_Buffer is True, any input waiting from the process (or in the
296    --  buffer) is first discarded before the command is sent. The output
297    --  filters are of course called as usual.
298
299    -----------------------------------------------------------
300    -- Working on the output (single process, simple regexp) --
301    -----------------------------------------------------------
302
303    type Expect_Match is new Integer;
304    Expect_Full_Buffer : constant Expect_Match := -1;
305    --  If the buffer was full and some characters were discarded.
306
307    Expect_Timeout : constant Expect_Match := -2;
308    --  If not output matching the regexps was found before the timeout.
309
310    function "+" (S : String) return GNAT.OS_Lib.String_Access;
311    --  Allocate some memory for the string. This is merely a convenience
312    --  convenience function to help create the array of regexps in the
313    --  call to Expect.
314
315    procedure Expect
316      (Descriptor  : in out Process_Descriptor;
317       Result      : out Expect_Match;
318       Regexp      : String;
319       Timeout     : Integer := 10000;
320       Full_Buffer : Boolean := False);
321    --  Wait till a string matching Fd can be read from Fd, and return 1
322    --  if a match was found.
323    --
324    --  It consumes all the characters read from Fd until a match found, and
325    --  then sets the return values for the subprograms Expect_Out and
326    --  Expect_Out_Match.
327    --
328    --  The empty string "" will never match, and can be used if you only want
329    --  to match after a specific timeout. Beware that if Timeout is -1 at the
330    --  time, the current task will be blocked forever.
331    --
332    --  This command times out after Timeout milliseconds (or never if Timeout
333    --  is -1). In that case, Expect_Timeout is returned. The value returned by
334    --  Expect_Out and Expect_Out_Match are meaningless in that case.
335    --
336    --  Note that using a timeout of 0ms leads to unpredictable behavior, since
337    --  the result depends on whether the process has already sent some output
338    --  the first time Expect checks, and this depends on the operating system.
339    --
340    --  The regular expression must obey the syntax described in GNAT.Regpat.
341    --
342    --  If Full_Buffer is True, then Expect will match if the buffer was too
343    --  small and some characters were about to be discarded. In that case,
344    --  Expect_Full_Buffer is returned.
345
346    procedure Expect
347      (Descriptor  : in out Process_Descriptor;
348       Result      : out Expect_Match;
349       Regexp      : GNAT.Regpat.Pattern_Matcher;
350       Timeout     : Integer := 10000;
351       Full_Buffer : Boolean := False);
352    --  Same as the previous one, but with a precompiled regular expression.
353    --  This is more efficient however, especially if you are using this
354    --  expression multiple times, since this package won't need to recompile
355    --  the regexp every time.
356
357    procedure Expect
358      (Descriptor  : in out Process_Descriptor;
359       Result      : out Expect_Match;
360       Regexp      : String;
361       Matched     : out GNAT.Regpat.Match_Array;
362       Timeout     : Integer := 10000;
363       Full_Buffer : Boolean := False);
364    --  Same as above, but it is now possible to get the indexes of the
365    --  substrings for the parentheses in the regexp (see the example at the
366    --  top of this package, as well as the documentation in the package
367    --  GNAT.Regpat).
368    --
369    --  Matched'First should be 0, and this index will contain the indexes for
370    --  the whole string that was matched. The index 1 will contain the indexes
371    --  for the first parentheses-pair, and so on.
372
373    ------------
374    -- Expect --
375    ------------
376
377    procedure Expect
378      (Descriptor  : in out Process_Descriptor;
379       Result      : out Expect_Match;
380       Regexp      : GNAT.Regpat.Pattern_Matcher;
381       Matched     : out GNAT.Regpat.Match_Array;
382       Timeout     : Integer := 10000;
383       Full_Buffer : Boolean := False);
384    --  Same as above, but with a precompiled regular expression.
385
386    -------------------------------------------------------------
387    -- Working on the output (single process, multiple regexp) --
388    -------------------------------------------------------------
389
390    type Regexp_Array is array (Positive range <>) of GNAT.OS_Lib.String_Access;
391
392    type Pattern_Matcher_Access is access GNAT.Regpat.Pattern_Matcher;
393    type Compiled_Regexp_Array is array (Positive range <>)
394      of Pattern_Matcher_Access;
395
396    function "+"
397      (P    : GNAT.Regpat.Pattern_Matcher)
398       return Pattern_Matcher_Access;
399    --  Allocate some memory for the pattern matcher.
400    --  This is only a convenience function to help create the array of
401    --  compiled regular expressoins.
402
403    procedure Expect
404      (Descriptor  : in out Process_Descriptor;
405       Result      : out Expect_Match;
406       Regexps     : Regexp_Array;
407       Timeout     : Integer := 10000;
408       Full_Buffer : Boolean := False);
409    --  Wait till a string matching one of the regular expressions in Regexps
410    --  is found. This function returns the index of the regexp that matched.
411    --  This command is blocking, but will timeout after Timeout milliseconds.
412    --  In that case, Timeout is returned.
413
414    procedure Expect
415      (Descriptor  : in out Process_Descriptor;
416       Result      : out Expect_Match;
417       Regexps     : Compiled_Regexp_Array;
418       Timeout     : Integer := 10000;
419       Full_Buffer : Boolean := False);
420    --  Same as the previous one, but with precompiled regular expressions.
421    --  This can be much faster if you are using them multiple times.
422
423    procedure Expect
424      (Descriptor  : in out Process_Descriptor;
425       Result      : out Expect_Match;
426       Regexps     : Regexp_Array;
427       Matched     : out GNAT.Regpat.Match_Array;
428       Timeout     : Integer := 10000;
429       Full_Buffer : Boolean := False);
430    --  Same as above, except that you can also access the parenthesis
431    --  groups inside the matching regular expression.
432    --  The first index in Matched must be 0, or Constraint_Error will be
433    --  raised. The index 0 contains the indexes for the whole string that was
434    --  matched, the index 1 contains the indexes for the first parentheses
435    --  pair, and so on.
436
437    procedure Expect
438      (Descriptor  : in out Process_Descriptor;
439       Result      : out Expect_Match;
440       Regexps     : Compiled_Regexp_Array;
441       Matched     : out GNAT.Regpat.Match_Array;
442       Timeout     : Integer := 10000;
443       Full_Buffer : Boolean := False);
444    --  Same as above, but with precompiled regular expressions.
445    --  The first index in Matched must be 0, or Constraint_Error will be
446    --  raised.
447
448    -------------------------------------------
449    -- Working on the output (multi-process) --
450    -------------------------------------------
451
452    type Multiprocess_Regexp is record
453       Descriptor : Process_Descriptor_Access;
454       Regexp     : Pattern_Matcher_Access;
455    end record;
456    type Multiprocess_Regexp_Array is array (Positive range <>)
457      of Multiprocess_Regexp;
458
459    procedure Expect
460      (Result      : out Expect_Match;
461       Regexps     : Multiprocess_Regexp_Array;
462       Matched     : out GNAT.Regpat.Match_Array;
463       Timeout     : Integer := 10000;
464       Full_Buffer : Boolean := False);
465    --  Same as above, but for multi processes.
466
467    procedure Expect
468      (Result      : out Expect_Match;
469       Regexps     : Multiprocess_Regexp_Array;
470       Timeout     : Integer := 10000;
471       Full_Buffer : Boolean := False);
472    --  Same as the previous one, but for multiple processes.
473    --  This procedure finds the first regexp that match the associated process.
474
475    ------------------------
476    -- Getting the output --
477    ------------------------
478
479    procedure Flush
480      (Descriptor : in out Process_Descriptor;
481       Timeout    : Integer := 0);
482    --  Discard all output waiting from the process.
483    --
484    --  This output is simply discarded, and no filter is called. This output
485    --  will also not be visible by the next call to Expect, nor will any
486    --  output currently buffered.
487    --
488    --  Timeout is the delay for which we wait for output to be available from
489    --  the process. If 0, we only get what is immediately available.
490
491    function Expect_Out (Descriptor : Process_Descriptor) return String;
492    --  Return the string matched by the last Expect call.
493    --
494    --  The returned string is in fact the concatenation of all the strings
495    --  read from the file descriptor up to, and including, the characters
496    --  that matched the regular expression.
497    --
498    --  For instance, with an input "philosophic", and a regular expression
499    --  "hi" in the call to expect, the strings returned the first and second
500    --  time would be respectively "phi" and "losophi".
501
502    function Expect_Out_Match (Descriptor : Process_Descriptor) return String;
503    --  Return the string matched by the last Expect call.
504    --
505    --  The returned string includes only the character that matched the
506    --  specific regular expression. All the characters that came before are
507    --  simply discarded.
508    --
509    --  For instance, with an input "philosophic", and a regular expression
510    --  "hi" in the call to expect, the strings returned the first and second
511    --  time would both be "hi".
512
513    ----------------
514    -- Exceptions --
515    ----------------
516
517    Invalid_Process : exception;
518    --  Raised by most subprograms above when the parameter Descriptor is not a
519    --  valid process or is a closed process.
520
521    Process_Died : exception;
522    --  Raised by all the expect subprograms if Descriptor was originally a
523    --  valid process that died while Expect was executing. It is also raised
524    --  when Expect receives an end-of-file.
525
526 private
527    type Filter_List_Elem;
528    type Filter_List is access Filter_List_Elem;
529    type Filter_List_Elem is record
530       Filter    : Filter_Function;
531       User_Data : System.Address;
532       Filter_On : Filter_Type;
533       Next      : Filter_List;
534    end record;
535
536    type Pipe_Type is record
537       Input, Output : GNAT.OS_Lib.File_Descriptor;
538    end record;
539    --  This type represents a pipe, used to communicate between two processes.
540
541    procedure Set_Up_Communications
542      (Pid        : in out Process_Descriptor;
543       Err_To_Out : Boolean;
544       Pipe1      : access Pipe_Type;
545       Pipe2      : access Pipe_Type;
546       Pipe3      : access Pipe_Type);
547    --  Set up all the communication pipes and file descriptors prior to
548    --  spawning the child process.
549
550    procedure Set_Up_Parent_Communications
551      (Pid   : in out Process_Descriptor;
552       Pipe1 : in out Pipe_Type;
553       Pipe2 : in out Pipe_Type;
554       Pipe3 : in out Pipe_Type);
555    --  Finish the set up of the pipes while in the parent process
556
557    procedure Set_Up_Child_Communications
558      (Pid   : in out Process_Descriptor;
559       Pipe1 : in out Pipe_Type;
560       Pipe2 : in out Pipe_Type;
561       Pipe3 : in out Pipe_Type;
562       Cmd   : String;
563       Args  : System.Address);
564    --  Finish the set up of the pipes while in the child process
565    --  This also spawns the child process (based on Cmd).
566    --  On systems that support fork, this procedure is executed inside the
567    --  newly created process.
568
569    type Process_Descriptor is tagged record
570       Pid              : aliased Process_Id := Invalid_Pid;
571       Input_Fd         : GNAT.OS_Lib.File_Descriptor := GNAT.OS_Lib.Invalid_FD;
572       Output_Fd        : GNAT.OS_Lib.File_Descriptor := GNAT.OS_Lib.Invalid_FD;
573       Error_Fd         : GNAT.OS_Lib.File_Descriptor := GNAT.OS_Lib.Invalid_FD;
574       Filters_Lock     : Integer := 0;
575
576       Filters          : Filter_List := null;
577
578       Buffer           : GNAT.OS_Lib.String_Access := null;
579       Buffer_Size      : Natural := 0;
580       Buffer_Index     : Natural := 0;
581
582       Last_Match_Start : Natural := 0;
583       Last_Match_End   : Natural := 0;
584    end record;
585
586    --  The following subprogram is provided for use in the body, and also
587    --  possibly in future child units providing extensions to this package.
588
589    procedure Portable_Execvp
590      (Pid  : access Process_Id;
591       Cmd  : String;
592       Args : System.Address);
593    pragma Import (C, Portable_Execvp, "__gnat_expect_portable_execvp");
594    --  Executes, in a portable way, the command Cmd (full path must be
595    --  specified), with the given Args. Args must be an array of string
596    --  pointers. Note that the first element in Args must be the executable
597    --  name, and the last element must be a null pointer. The returned value
598    --  in Pid is the process ID, or zero if not supported on the platform.
599
600 end GNAT.Expect;