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-2003 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 was originally developed by the GNAT team at New York University. -- 30-- Extensive contributions were provided by Ada Core Technologies Inc. -- 31-- -- 32------------------------------------------------------------------------------ 33 34-- Currently this package is implemented on all native GNAT ports except 35-- for VMS. It is not yet implemented for any of the cross-ports (e.g. it 36-- is not available for VxWorks or LynxOS). 37 38-- Usage 39-- ===== 40 41-- This package provides a set of subprograms similar to what is available 42-- with the standard Tcl Expect tool. 43 44-- It allows you to easily spawn and communicate with an external process. 45-- You can send commands or inputs to the process, and compare the output 46-- with some expected regular expression. 47 48-- Usage example: 49 50-- Non_Blocking_Spawn 51-- (Fd, "ftp", 52-- (1 => new String' ("machine@domaine"))); 53-- Timeout := 10000; -- 10 seconds 54-- Expect (Fd, Result, Regexp_Array'(+"\(user\)", +"\(passwd\)"), 55-- Timeout); 56-- case Result is 57-- when 1 => Send (Fd, "my_name"); -- matched "user" 58-- when 2 => Send (Fd, "my_passwd"); -- matched "passwd" 59-- when Expect_Timeout => null; -- timeout 60-- when others => null; 61-- end case; 62-- Close (Fd); 63 64-- You can also combine multiple regular expressions together, and get the 65-- specific string matching a parenthesis pair by doing something like. If you 66-- expect either "lang=optional ada" or "lang=ada" from the external process, 67-- you can group the two together, which is more efficient, and simply get the 68-- name of the language by doing: 69 70-- declare 71-- Matched : Regexp_Array (0 .. 2); 72-- begin 73-- Expect (Fd, Result, "lang=(optional)? ([a-z]+)", Matched); 74-- Put_Line ("Seen: " & 75-- Expect_Out (Fd) (Matched (2).First .. Matched (2).Last)); 76-- end; 77 78-- Alternatively, you might choose to use a lower-level interface to the 79-- processes, where you can give your own input and output filters every 80-- time characters are read from or written to the process. 81 82-- procedure My_Filter 83-- (Descriptor : Process_Descriptor'Class; 84-- Str : String; 85-- User_Data : System.Address) 86-- is 87-- begin 88-- Put_Line (Str); 89-- end; 90 91-- Non_Blocking_Spawn 92-- (Fd, "tail", 93-- (new String' ("-f"), new String' ("a_file"))); 94-- Add_Filter (Fd, My_Filter'Access, Output); 95-- Expect (Fd, Result, "", 0); -- wait forever 96 97-- The above example should probably be run in a separate task, since it is 98-- blocking on the call to Expect. 99 100-- Both examples can be combined, for instance to systematically print the 101-- output seen by expect, even though you still want to let Expect do the 102-- filtering. You can use the Trace_Filter subprogram for such a filter. 103 104-- If you want to get the output of a simple command, and ignore any previous 105-- existing output, it is recommended to do something like: 106 107-- Expect (Fd, Result, ".*", Timeout => 0); 108-- -- Empty the buffer, by matching everything (after checking 109-- -- if there was any input). 110 111-- Send (Fd, "command"); 112-- Expect (Fd, Result, ".."); -- match only on the output of command 113 114-- Task Safety 115-- =========== 116 117-- This package is not task-safe: there should be not concurrent calls to 118-- the functions defined in this package. 119 120with System; 121with GNAT.OS_Lib; 122with GNAT.Regpat; 123 124package 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 assocated 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 526private 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 600end GNAT.Expect; 601