* 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)

rtl/unix/sysutils.pp

@@ -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}
+    {$ifdef FPC_USE_FPEXEC}
-      fpexecl(Path,[Comline]);
+      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

rtl/unix/unix.pp

@@ -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

rtl/unix/unixutil.pp

@@ -13,9 +13,10 @@ Type
   ExtStr  = String[255];
 
 Function Dirname(Const path:pathstr):pathstr;
-Function StringToPPChar(S: PChar):ppchar;
+Function StringToPPChar(S: PChar;ReserveEntries:integer):ppchar;
-Function StringToPPChar(Var S:String):ppchar;
+Function StringToPPChar(Var S:String;ReserveEntries:integer):ppchar;
-Function StringToPPChar(Var S:AnsiString):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
+     if buf^='"' Then			// quotes argument?
-      inc(buf);
+      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;
+       buf^:=#0;
-        inc(buf);
+       inc(buf);
       end;
-     p^:=buf;
+     if buf^='"' Then			// quotes argument?
-     inc(p);
+      begin 
-     p^:=nil;
+	inc(buf);
-     while not (buf^ in [' ',#0,#9,#10]) do
+        p^:=buf;
-      inc(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;
 

rtl/win32/sysutils.pp

@@ -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