mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-04-08 11:48:04 +02:00
* Hopefully last large changes to fpexec and friends.
- naming conventions changes from Michael. - shell functions get alternative under ifdef. - arraystring function moves to unixutil - unixutil now regards quotes in stringtoppchar. - sysutils/unix get executeprocess(ansi,array of ansi), and both executeprocess functions are fixed - Sysutils/win32 get executeprocess(ansi,array of ansi)
This commit is contained in:
marco
parent
aec3ded0cf
commit
c2d60c1a8b
@ -486,19 +486,29 @@ begin
|
||||
Result:=StrPas(BaseUnix.FPGetenv(PChar(EnvVar)));
|
||||
end;
|
||||
|
||||
{$define FPC_USE_FPEXEC} // leave the old code under IFDEF for a while.
|
||||
function ExecuteProcess(Const Path: AnsiString; Const ComLine: AnsiString):integer;
|
||||
var
|
||||
pid : longint;
|
||||
err : longint;
|
||||
e : EOSError;
|
||||
e : EOSError;
|
||||
CommandLine: AnsiString;
|
||||
cmdline2 : ppchar;
|
||||
|
||||
Begin
|
||||
{ always surround the name of the application by quotes
|
||||
so that long filenames will always be accepted. But don't
|
||||
do it if there are already double quotes!
|
||||
}
|
||||
{$ifndef FPC_HAS_FPEXEC}
|
||||
{$ifdef FPC_USE_FPEXEC} // Only place we still parse
|
||||
cmdline2:=nil;
|
||||
if Comline<>'' Then
|
||||
begin
|
||||
CommandLine:=ComLine;
|
||||
cmdline2:=StringtoPPChar(CommandLine,1);
|
||||
cmdline2^:=pchar(Path);
|
||||
end;
|
||||
{$else}
|
||||
if Pos ('"', Path) = 0 then
|
||||
CommandLine := '"' + Path + '"'
|
||||
else
|
||||
@ -510,8 +520,8 @@ Begin
|
||||
if pid=0 then
|
||||
begin
|
||||
{The child does the actual exec, and then exits}
|
||||
{$ifdef FPC_HAS_FPEXEC}
|
||||
fpexecl(Path,[Comline]);
|
||||
{$ifdef FPC_USE_FPEXEC}
|
||||
fpexecv(pchar(Path),Cmdline2);
|
||||
{$else}
|
||||
Execl(CommandLine);
|
||||
{$endif}
|
||||
@ -539,6 +549,48 @@ Begin
|
||||
end;
|
||||
End;
|
||||
|
||||
function ExecuteProcess(Const Path: AnsiString; Const ComLine: Array Of AnsiString):integer;
|
||||
|
||||
var
|
||||
pid : longint;
|
||||
err : longint;
|
||||
e : EOSError;
|
||||
|
||||
Begin
|
||||
{ always surround the name of the application by quotes
|
||||
so that long filenames will always be accepted. But don't
|
||||
do it if there are already double quotes!
|
||||
}
|
||||
pid:=fpFork;
|
||||
if pid=0 then
|
||||
begin
|
||||
{The child does the actual exec, and then exits}
|
||||
fpexecl(Path,Comline);
|
||||
{ If the execve fails, we return an exitvalue of 127, to let it be known}
|
||||
fpExit(127);
|
||||
end
|
||||
else
|
||||
if pid=-1 then {Fork failed}
|
||||
begin
|
||||
e:=EOSError.CreateFmt(SExecuteProcessFailed,[Path,-1]);
|
||||
e.ErrorCode:=-1;
|
||||
raise e;
|
||||
end;
|
||||
|
||||
{ We're in the parent, let's wait. }
|
||||
result:=WaitProcess(pid); // WaitPid and result-convert
|
||||
|
||||
if (result>=0) and (result<>127) then
|
||||
result:=0
|
||||
else
|
||||
begin
|
||||
e:=EOSError.CreateFmt(SExecuteProcessFailed,[Path,result]);
|
||||
e.ErrorCode:=result;
|
||||
raise e;
|
||||
end;
|
||||
End;
|
||||
|
||||
|
||||
procedure Sleep(milliseconds: Cardinal);
|
||||
|
||||
Var
|
||||
@ -577,7 +629,17 @@ end.
|
||||
{
|
||||
|
||||
$Log$
|
||||
Revision 1.35 2004-02-12 15:31:06 marco
|
||||
Revision 1.36 2004-02-13 10:50:23 marco
|
||||
* Hopefully last large changes to fpexec and friends.
|
||||
- naming conventions changes from Michael.
|
||||
- shell functions get alternative under ifdef.
|
||||
- arraystring function moves to unixutil
|
||||
- unixutil now regards quotes in stringtoppchar.
|
||||
- sysutils/unix get executeprocess(ansi,array of ansi), and
|
||||
both executeprocess functions are fixed
|
||||
- Sysutils/win32 get executeprocess(ansi,array of ansi)
|
||||
|
||||
Revision 1.35 2004/02/12 15:31:06 marco
|
||||
* First version of fpexec change. Still under ifdef or silently overloaded
|
||||
|
||||
Revision 1.34 2004/02/09 17:11:17 marco
|
||||
|
||||
@ -212,14 +212,14 @@ const
|
||||
***************************}
|
||||
|
||||
Type
|
||||
TFSearchOptions = (NoCurrentDirectory,
|
||||
TFSearchOption = (NoCurrentDirectory,
|
||||
CurrentDirectoryFirst,
|
||||
CurrentDirectoryLast);
|
||||
|
||||
Function FExpand (Const Path: PathStr):PathStr;
|
||||
Function FSearch (const path:pathstr;dirlist:string):pathstr;
|
||||
|
||||
Function FSearch (const path:AnsiString;dirlist:Ansistring;AddCurrentPath:TFSearchOptions):AnsiString;
|
||||
Function FSearch (const path:AnsiString;dirlist:Ansistring;CurrentDirStrategy:TFSearchOption):AnsiString;
|
||||
Function FSearch (const path:AnsiString;dirlist:AnsiString):AnsiString;
|
||||
Function Glob (Const path:pathstr):pglob;
|
||||
Procedure Globfree (var p:pglob);
|
||||
@ -431,7 +431,7 @@ Function Execle(Todo:string;Ep:ppchar):cint;
|
||||
var
|
||||
p : ppchar;
|
||||
begin
|
||||
p:=StringToPPChar(ToDo);
|
||||
p:=StringToPPChar(ToDo,0);
|
||||
if (p=nil) or (p^=nil) then
|
||||
Begin
|
||||
fpsetErrno(ESysEnoEnt);
|
||||
@ -453,7 +453,7 @@ function Execle(Todo:AnsiString;Ep:ppchar):cint;
|
||||
var
|
||||
p : ppchar;
|
||||
begin
|
||||
p:=StringToPPChar(ToDo);
|
||||
p:=StringToPPChar(ToDo,0);
|
||||
if (p=nil) or (p^=nil) then
|
||||
Begin
|
||||
fpsetErrno(ESysEnoEnt);
|
||||
@ -487,7 +487,7 @@ Function Execlp(Todo:string;Ep:ppchar):cint;
|
||||
var
|
||||
p : ppchar;
|
||||
begin
|
||||
p:=StringToPPchar(todo);
|
||||
p:=StringToPPchar(todo,0);
|
||||
if (p=nil) or (p^=nil) then
|
||||
Begin
|
||||
fpsetErrno(ESysEnoEnt);
|
||||
@ -503,7 +503,7 @@ Function Execlp(Todo: Ansistring;Ep:ppchar):cint;
|
||||
var
|
||||
p : ppchar;
|
||||
begin
|
||||
p:=StringToPPchar(todo);
|
||||
p:=StringToPPchar(todo,0);
|
||||
if (p=nil) or (p^=nil) then
|
||||
Begin
|
||||
fpsetErrno(ESysEnoEnt);
|
||||
@ -512,31 +512,6 @@ begin
|
||||
execlp:=ExecVP(StrPas(p^),p,EP);
|
||||
end;
|
||||
|
||||
function ArrayStringToPPchar(const S:Array of AnsiString;reserveentries:Longint):ppchar; // const ?
|
||||
// Extra allocate reserveentries pchar's at the beginning (default param=0 after 1.0.x ?)
|
||||
// Note: for internal use by skilled programmers only
|
||||
// if "s" goes out of scope in the parent procedure, the pointer is dangling.
|
||||
|
||||
var p : ppchar;
|
||||
Res,
|
||||
i : LongInt;
|
||||
begin
|
||||
if High(s)<Low(s) Then Exit(NIL);
|
||||
Getmem(p,sizeof(pchar)*(high(s)-low(s)+ReserveEntries+2)); // one more for NIL, one more
|
||||
// for cmd
|
||||
if p=nil then
|
||||
begin
|
||||
{$ifdef xunix}
|
||||
fpseterrno(ESysEnomem);
|
||||
{$endif}
|
||||
exit(NIL);
|
||||
end;
|
||||
for i:=low(s) to high(s) do
|
||||
p[i+Reserveentries]:=pchar(s[i]);
|
||||
p[high(s)+1+Reserveentries]:=nil;
|
||||
ArrayStringToPPchar:=p;
|
||||
end;
|
||||
|
||||
function intFpExecVEMaybeP (Const PathName:AnsiString;Args,MyEnv:ppchar;SearchPath:Boolean):cint;
|
||||
// does an ExecVE, but still has to handle P
|
||||
// execv variants call this directly, execl variants indirectly via
|
||||
@ -621,6 +596,8 @@ begin
|
||||
End;
|
||||
p^:=pchar(PathName);
|
||||
IntFPExecL:=intFpExecVEMaybeP(PathName,p,MyEnv,SearchPath);
|
||||
// If we come here, no attempts were executed successfully.
|
||||
Freemem(p);
|
||||
end;
|
||||
|
||||
function FpExecLE (Const PathName:AnsiString;const S:Array Of AnsiString;MyEnv:ppchar):cint;
|
||||
@ -679,22 +656,32 @@ Function Shell(const Command:String):cint;
|
||||
- The Old CreateShellArg gives back pointers to a local var
|
||||
}
|
||||
var
|
||||
{$ifndef FPC_USE_FPEXEC}
|
||||
p : ppchar;
|
||||
{$endif}
|
||||
pid : cint;
|
||||
begin
|
||||
{$ifndef FPC_USE_FPEXEC}
|
||||
p:=CreateShellArgv(command);
|
||||
{$endif}
|
||||
pid:=fpfork;
|
||||
if pid=0 then // We are in the Child
|
||||
begin
|
||||
{This is the child.}
|
||||
fpExecve(p^,p,envp);
|
||||
{$ifndef FPC_USE_FPEXEC}
|
||||
fpExecve(p^,p,envp);
|
||||
{$else}
|
||||
fpexecl('/bin/sh',['-c',Command]);
|
||||
{$endif}
|
||||
fpExit(127); // was Exit(127)
|
||||
end
|
||||
else if (pid<>-1) then // Successfull started
|
||||
Shell:=WaitProcess(pid)
|
||||
else // no success
|
||||
Shell:=-1; // indicate an error
|
||||
{$ifndef FPC_USE_FPEXEC}
|
||||
FreeShellArgV(p);
|
||||
{$endif}
|
||||
end;
|
||||
|
||||
Function Shell(const Command:AnsiString):cint;
|
||||
@ -1513,7 +1500,7 @@ Begin
|
||||
End;
|
||||
End;
|
||||
|
||||
Function FSearch(const path:AnsiString;dirlist:Ansistring;AddCurrentPath:TFSearchOptions):AnsiString;
|
||||
Function FSearch(const path:AnsiString;dirlist:Ansistring;CurrentDirStrategy:TFSearchOption):AnsiString;
|
||||
{
|
||||
Searches for a file 'path' in the list of direcories in 'dirlist'.
|
||||
returns an empty string if not found. Wildcards are NOT allowed.
|
||||
@ -1531,9 +1518,9 @@ Var
|
||||
p : pchar;
|
||||
Begin
|
||||
|
||||
if AddCurrentPath=CurrentDirectoryFirst Then
|
||||
if CurrentDirStrategy=CurrentDirectoryFirst Then
|
||||
Dirlist:='.:'+dirlist; {Make sure current dir is first to be searched.}
|
||||
if AddCurrentPath=CurrentDirectoryLast Then
|
||||
if CurrentDirStrategy=CurrentDirectoryLast Then
|
||||
Dirlist:=dirlist+':.'; {Make sure current dir is last to be searched.}
|
||||
|
||||
{Replace ':' and ';' with #0}
|
||||
@ -1673,7 +1660,17 @@ End.
|
||||
|
||||
{
|
||||
$Log$
|
||||
Revision 1.62 2004-02-12 16:20:58 marco
|
||||
Revision 1.63 2004-02-13 10:50:22 marco
|
||||
* Hopefully last large changes to fpexec and friends.
|
||||
- naming conventions changes from Michael.
|
||||
- shell functions get alternative under ifdef.
|
||||
- arraystring function moves to unixutil
|
||||
- unixutil now regards quotes in stringtoppchar.
|
||||
- sysutils/unix get executeprocess(ansi,array of ansi), and
|
||||
both executeprocess functions are fixed
|
||||
- Sysutils/win32 get executeprocess(ansi,array of ansi)
|
||||
|
||||
Revision 1.62 2004/02/12 16:20:58 marco
|
||||
* currentpath stuff fixed for fsearch
|
||||
|
||||
Revision 1.61 2004/02/12 15:31:06 marco
|
||||
|
||||
@ -13,9 +13,10 @@ Type
|
||||
ExtStr = String[255];
|
||||
|
||||
Function Dirname(Const path:pathstr):pathstr;
|
||||
Function StringToPPChar(S: PChar):ppchar;
|
||||
Function StringToPPChar(Var S:String):ppchar;
|
||||
Function StringToPPChar(Var S:AnsiString):ppchar;
|
||||
Function StringToPPChar(S: PChar;ReserveEntries:integer):ppchar;
|
||||
Function StringToPPChar(Var S:String;ReserveEntries:integer):ppchar;
|
||||
Function StringToPPChar(Var S:AnsiString;ReserveEntries:integer):ppchar;
|
||||
function ArrayStringToPPchar(const S:Array of AnsiString;reserveentries:Longint):ppchar; // const ?
|
||||
Function Basename(Const path:pathstr;Const suf:pathstr):pathstr;
|
||||
Function FNMatch(const Pattern,Name:string):Boolean;
|
||||
Function GetFS (var T:Text):longint;
|
||||
@ -31,6 +32,32 @@ implementation
|
||||
{$I textrec.inc}
|
||||
{$i filerec.inc}
|
||||
|
||||
function ArrayStringToPPchar(const S:Array of AnsiString;reserveentries:Longint):ppchar; // const ?
|
||||
// Extra allocate reserveentries pchar's at the beginning (default param=0 after 1.0.x ?)
|
||||
// Note: for internal use by skilled programmers only
|
||||
// if "s" goes out of scope in the parent procedure, the pointer is dangling.
|
||||
|
||||
var p : ppchar;
|
||||
Res,
|
||||
i : LongInt;
|
||||
begin
|
||||
if High(s)<Low(s) Then Exit(NIL);
|
||||
Getmem(p,sizeof(pchar)*(high(s)-low(s)+ReserveEntries+2)); // one more for NIL, one more
|
||||
// for cmd
|
||||
if p=nil then
|
||||
begin
|
||||
{$ifdef xunix}
|
||||
fpseterrno(ESysEnomem);
|
||||
{$endif}
|
||||
exit(NIL);
|
||||
end;
|
||||
for i:=low(s) to high(s) do
|
||||
p[i+Reserveentries]:=pchar(s[i]);
|
||||
p[high(s)+1+Reserveentries]:=nil;
|
||||
ArrayStringToPPchar:=p;
|
||||
end;
|
||||
|
||||
|
||||
Procedure FSplit(const Path:PathStr;Var Dir:DirStr;Var Name:NameStr;Var Ext:ExtStr);
|
||||
Var
|
||||
DotPos,SlashPos,i : longint;
|
||||
@ -71,7 +98,7 @@ begin
|
||||
DirName:=Dir;
|
||||
end;
|
||||
|
||||
Function StringToPPChar(Var S:String):ppchar;
|
||||
Function StringToPPChar(Var S:String;ReserveEntries:integer):ppchar;
|
||||
{
|
||||
Create a PPChar to structure of pchars which are the arguments specified
|
||||
in the string S. Especially usefull for creating an ArgV for Exec-calls
|
||||
@ -80,38 +107,51 @@ Function StringToPPChar(Var S:String):ppchar;
|
||||
|
||||
begin
|
||||
S:=S+#0;
|
||||
StringToPPChar:=StringToPPChar(@S[1]);
|
||||
StringToPPChar:=StringToPPChar(pchar(@S[1]),ReserveEntries);
|
||||
end;
|
||||
|
||||
Function StringToPPChar(Var S:AnsiString):ppchar;
|
||||
Function StringToPPChar(Var S:AnsiString;ReserveEntries:integer):ppchar;
|
||||
{
|
||||
Create a PPChar to structure of pchars which are the arguments specified
|
||||
in the string S. Especially usefull for creating an ArgV for Exec-calls
|
||||
}
|
||||
|
||||
begin
|
||||
StringToPPChar:=StringToPPChar(PChar(S));
|
||||
StringToPPChar:=StringToPPChar(PChar(S),ReserveEntries);
|
||||
end;
|
||||
|
||||
Function StringToPPChar(S: PChar):ppchar;
|
||||
Function StringToPPChar(S: PChar;ReserveEntries:integer):ppchar;
|
||||
|
||||
var
|
||||
nr : longint;
|
||||
i,nr : longint;
|
||||
Buf : ^char;
|
||||
p : ppchar;
|
||||
InQuote : Boolean;
|
||||
|
||||
begin
|
||||
buf:=s;
|
||||
nr:=0;
|
||||
while(buf^<>#0) do
|
||||
InQuote:=false;
|
||||
while (buf^<>#0) do // count nr of args
|
||||
begin
|
||||
while (buf^ in [' ',#9,#10]) do
|
||||
while (buf^ in [' ',#9,#10]) do // Kill separators.
|
||||
inc(buf);
|
||||
inc(nr);
|
||||
while not (buf^ in [' ',#0,#9,#10]) do
|
||||
inc(buf);
|
||||
if buf^='"' Then // quotes argument?
|
||||
begin
|
||||
inc(buf);
|
||||
while not (buf^ in [#0,'"']) do // then end of argument is end of string or next quote
|
||||
inc(buf);
|
||||
if buf^='"' then // skip closing quote.
|
||||
inc(buf);
|
||||
end
|
||||
else
|
||||
begin // else std
|
||||
while not (buf^ in [' ',#0,#9,#10]) do
|
||||
inc(buf);
|
||||
end;
|
||||
end;
|
||||
getmem(p,nr*4);
|
||||
getmem(p,(ReserveEntries+nr)*sizeof(pchar));
|
||||
StringToPPChar:=p;
|
||||
if p=nil then
|
||||
begin
|
||||
@ -120,19 +160,37 @@ begin
|
||||
{$endif}
|
||||
exit;
|
||||
end;
|
||||
for i:=1 to ReserveEntries do inc(p); // skip empty slots
|
||||
buf:=s;
|
||||
while (buf^<>#0) do
|
||||
begin
|
||||
while (buf^ in [' ',#9,#10]) do
|
||||
while (buf^ in [' ',#9,#10]) do // Kill separators.
|
||||
begin
|
||||
buf^:=#0;
|
||||
inc(buf);
|
||||
buf^:=#0;
|
||||
inc(buf);
|
||||
end;
|
||||
p^:=buf;
|
||||
inc(p);
|
||||
p^:=nil;
|
||||
while not (buf^ in [' ',#0,#9,#10]) do
|
||||
inc(buf);
|
||||
if buf^='"' Then // quotes argument?
|
||||
begin
|
||||
inc(buf);
|
||||
p^:=buf;
|
||||
inc(p);
|
||||
p^:=nil;
|
||||
while not (buf^ in [#0,'"']) do // then end of argument is end of string or next quote
|
||||
inc(buf);
|
||||
if buf^='"' then // skip closing quote.
|
||||
begin
|
||||
buf^:=#0;
|
||||
inc(buf);
|
||||
end;
|
||||
end
|
||||
else
|
||||
begin
|
||||
p^:=buf;
|
||||
inc(p);
|
||||
p^:=nil;
|
||||
while not (buf^ in [' ',#0,#9,#10]) do
|
||||
inc(buf);
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
|
||||
|
||||
@ -727,6 +727,19 @@ begin
|
||||
end;
|
||||
end;
|
||||
|
||||
function ExecuteProcess(Const Path: AnsiString; Const ComLine: Array of AnsiString):integer;
|
||||
|
||||
Var
|
||||
CommandLine : AnsiString;
|
||||
i : Integer;
|
||||
|
||||
Begin
|
||||
Commandline:='';
|
||||
For i:=0 to high(ComLine) Do
|
||||
Commandline:=CommandLine+' '+Comline[i];
|
||||
ExecuteProcess:=ExecuteProcess(Path,CommandLine);
|
||||
End;
|
||||
|
||||
Procedure Sleep(Milliseconds : Cardinal);
|
||||
|
||||
begin
|
||||
@ -800,7 +813,17 @@ Finalization
|
||||
end.
|
||||
{
|
||||
$Log$
|
||||
Revision 1.32 2004-02-08 11:00:18 michael
|
||||
Revision 1.33 2004-02-13 10:50:23 marco
|
||||
* Hopefully last large changes to fpexec and friends.
|
||||
- naming conventions changes from Michael.
|
||||
- shell functions get alternative under ifdef.
|
||||
- arraystring function moves to unixutil
|
||||
- unixutil now regards quotes in stringtoppchar.
|
||||
- sysutils/unix get executeprocess(ansi,array of ansi), and
|
||||
both executeprocess functions are fixed
|
||||
- Sysutils/win32 get executeprocess(ansi,array of ansi)
|
||||
|
||||
Revision 1.32 2004/02/08 11:00:18 michael
|
||||
+ Implemented winsysut unit
|
||||
|
||||
Revision 1.31 2004/01/20 23:12:49 hajny
|
||||
|
||||
Loading…
Reference in New Issue
Block a user