end Flush;
+ ------------------------
+ -- Get_Command_Output --
+ ------------------------
+
+ function Get_Command_Output
+ (Command : String;
+ Arguments : GNAT.OS_Lib.Argument_List;
+ Input : String;
+ Status : access Integer;
+ Err_To_Out : Boolean := False) return String
+ is
+ use GNAT.Expect;
+
+ Process : Process_Descriptor;
+
+ Output : String_Access := new String (1 .. 1024);
+ -- Buffer used to accumulate standard output from the launched
+ -- command, expanded as necessary during execution.
+
+ Last : Integer := 0;
+ -- Index of the last used character within Output
+
+ begin
+ Non_Blocking_Spawn
+ (Process, Command, Arguments, Err_To_Out => Err_To_Out);
+
+ if Input'Length > 0 then
+ Send (Process, Input);
+ end if;
+
+ GNAT.OS_Lib.Close (Get_Input_Fd (Process));
+
+ declare
+ Result : Expect_Match;
+
+ begin
+ -- This loop runs until the call to Expect raises Process_Died
+
+ loop
+ Expect (Process, Result, ".+");
+
+ declare
+ NOutput : String_Access;
+ S : constant String := Expect_Out (Process);
+ pragma Assert (S'Length > 0);
+
+ begin
+ -- Expand buffer if we need more space
+
+ if Last + S'Length > Output'Last then
+ NOutput := new String (1 .. 2 * Output'Last);
+ NOutput (Output'Range) := Output.all;
+ Free (Output);
+
+ -- Here if current buffer size is OK
+
+ else
+ NOutput := Output;
+ end if;
+
+ NOutput (Last + 1 .. Last + S'Length) := S;
+ Last := Last + S'Length;
+ Output := NOutput;
+ end;
+ end loop;
+
+ exception
+ when Process_Died =>
+ Close (Process, Status.all);
+ end;
+
+ if Last = 0 then
+ return "";
+ end if;
+
+ declare
+ S : constant String := Output (1 .. Last);
+ begin
+ Free (Output);
+ return S;
+ end;
+ end Get_Command_Output;
+
------------------
-- Get_Error_Fd --
------------------
function Waitpid (Pid : Process_Id) return Integer;
pragma Import (C, Waitpid, "__gnat_waitpid");
- -- Wait for a specific process id, and return its exit code.
+ -- Wait for a specific process id, and return its exit code
---------
-- "+" --
Descriptors (J).Buffer_Size - N;
end if;
- -- Keep what we read in the buffer.
+ -- Keep what we read in the buffer
Descriptors (J).Buffer
(Descriptors (J).Buffer_Index + 1 ..
end if;
end case;
end loop;
-
end Flush;
+ ------------------------
+ -- Get_Command_Output --
+ ------------------------
+
+ function Get_Command_Output
+ (Command : String;
+ Arguments : GNAT.OS_Lib.Argument_List;
+ Input : String;
+ Status : access Integer;
+ Err_To_Out : Boolean := False) return String
+ is
+ use GNAT.Expect;
+
+ Process : Process_Descriptor;
+
+ Output : String_Access := new String (1 .. 1024);
+ -- Buffer used to accumulate standard output from the launched
+ -- command, expanded as necessary during execution.
+
+ Last : Integer := 0;
+ -- Index of the last used character within Output
+
+ begin
+ Non_Blocking_Spawn
+ (Process, Command, Arguments, Err_To_Out => Err_To_Out);
+
+ if Input'Length > 0 then
+ Send (Process, Input);
+ end if;
+
+ GNAT.OS_Lib.Close (Get_Input_Fd (Process));
+
+ declare
+ Result : Expect_Match;
+
+ begin
+ -- This loop runs until the call to Expect raises Process_Died
+
+ loop
+ Expect (Process, Result, ".+");
+
+ declare
+ NOutput : String_Access;
+ S : constant String := Expect_Out (Process);
+ pragma Assert (S'Length > 0);
+
+ begin
+ -- Expand buffer if we need more space
+
+ if Last + S'Length > Output'Last then
+ NOutput := new String (1 .. 2 * Output'Last);
+ NOutput (Output'Range) := Output.all;
+ Free (Output);
+
+ -- Here if current buffer size is OK
+
+ else
+ NOutput := Output;
+ end if;
+
+ NOutput (Last + 1 .. Last + S'Length) := S;
+ Last := Last + S'Length;
+ Output := NOutput;
+ end;
+ end loop;
+
+ exception
+ when Process_Died =>
+ Close (Process, Status.all);
+ end;
+
+ if Last = 0 then
+ return "";
+ end if;
+
+ declare
+ S : constant String := Output (1 .. Last);
+ begin
+ Free (Output);
+ return S;
+ end;
+ end Get_Command_Output;
+
------------------
-- Get_Error_Fd --
------------------
begin
if Empty_Buffer then
- -- Force a read on the process if there is anything waiting.
+ -- Force a read on the process if there is anything waiting
Expect_Internal (Descriptors, Result,
Timeout => 0, Full_Buffer => False);
is
begin
Kill (Descriptor.Pid, Signal);
- -- ??? Need to check process status here.
+ -- ??? Need to check process status here
end Send_Signal;
---------------------------------
-- --
-- S p e c --
-- --
--- Copyright (C) 2000-2004 Ada Core Technologies, Inc. --
+-- Copyright (C) 2000-2005 Ada Core Technologies, Inc. --
-- --
-- GNAT is free software; you can redistribute it and/or modify it under --
-- terms of the GNU General Public License as published by the Free Soft- --
-- for VMS. It is not yet implemented for any of the cross-ports (e.g. it
-- is not available for VxWorks or LynxOS).
--- Usage
--- =====
+-- -----------
+-- -- Usage --
+-- -----------
-- This package provides a set of subprograms similar to what is available
-- with the standard Tcl Expect tool.
-- Send (Fd, "command");
-- Expect (Fd, Result, ".."); -- match only on the output of command
--- Task Safety
--- ===========
+-- -----------------
+-- -- Task Safety --
+-- -----------------
-- This package is not task-safe: there should be not concurrent calls to
--- the functions defined in this package.
+-- the functions defined in this package. In other words, separate tasks
+-- may not access the facilities of this package without synchronization
+-- that serializes access.
with System;
with GNAT.OS_Lib;
procedure Send_Signal
(Descriptor : Process_Descriptor;
Signal : Integer);
- -- Send a given signal to the process.
+ -- Send a given signal to the process
procedure Interrupt (Descriptor : in out Process_Descriptor);
-- Interrupt the process (the equivalent of Ctrl-C on unix and windows)
function Get_Input_Fd
(Descriptor : Process_Descriptor)
return GNAT.OS_Lib.File_Descriptor;
- -- Return the input file descriptor associated with Descriptor.
+ -- Return the input file descriptor associated with Descriptor
function Get_Output_Fd
(Descriptor : Process_Descriptor)
return GNAT.OS_Lib.File_Descriptor;
- -- Return the output file descriptor associated with Descriptor.
+ -- Return the output file descriptor associated with Descriptor
function Get_Error_Fd
(Descriptor : Process_Descriptor)
return GNAT.OS_Lib.File_Descriptor;
- -- Return the error output file descriptor associated with Descriptor.
+ -- Return the error output file descriptor associated with Descriptor
function Get_Pid
(Descriptor : Process_Descriptor)
return Process_Id;
- -- Return the process id assocated with a given process descriptor.
+ -- Return the process id assocated with a given process descriptor
+
+ function Get_Command_Output
+ (Command : String;
+ Arguments : GNAT.OS_Lib.Argument_List;
+ Input : String;
+ Status : access Integer;
+ Err_To_Out : Boolean := False) return String;
+ -- Execute Command with the specified Arguments and Input, and return the
+ -- generated standard output data as a single string. If Err_To_Out is
+ -- True, generated standard error output is included as well. On return,
+ -- Status is set to the command's exit status.
--------------------
-- Adding filters --
type Expect_Match is new Integer;
Expect_Full_Buffer : constant Expect_Match := -1;
- -- If the buffer was full and some characters were discarded.
+ -- If the buffer was full and some characters were discarded
Expect_Timeout : constant Expect_Match := -2;
- -- If not output matching the regexps was found before the timeout.
+ -- If not output matching the regexps was found before the timeout
function "+" (S : String) return GNAT.OS_Lib.String_Access;
-- Allocate some memory for the string. This is merely a convenience
Matched : out GNAT.Regpat.Match_Array;
Timeout : Integer := 10000;
Full_Buffer : Boolean := False);
- -- Same as above, but with a precompiled regular expression.
+ -- Same as above, but with a precompiled regular expression
-------------------------------------------------------------
-- Working on the output (single process, multiple regexp) --
Matched : out GNAT.Regpat.Match_Array;
Timeout : Integer := 10000;
Full_Buffer : Boolean := False);
- -- Same as above, but for multi processes.
+ -- Same as above, but for multi processes
procedure Expect
(Result : out Expect_Match;
type Pipe_Type is record
Input, Output : GNAT.OS_Lib.File_Descriptor;
end record;
- -- This type represents a pipe, used to communicate between two processes.
+ -- This type represents a pipe, used to communicate between two processes
procedure Set_Up_Communications
(Pid : in out Process_Descriptor;
OSDN Git Service
