1 {
2  ***************************************************************************
3  *                                                                         *
4  *   This source is free software; you can redistribute it and/or modify   *
5  *   it under the terms of the GNU General Public License as published by  *
6  *   the Free Software Foundation; either version 2 of the License, or     *
7  *   (at your option) any later version.                                   *
8  *                                                                         *
9  *   This code is distributed in the hope that it will be useful, but      *
10  *   WITHOUT ANY WARRANTY; without even the implied warranty of            *
11  *   MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU     *
12  *   General Public License for more details.                              *
13  *                                                                         *
14  *   A copy of the GNU General Public License is available on the World    *
15  *   Wide Web at <http://www.gnu.org/copyleft/gpl.html>. You can also      *
16  *   obtain it by writing to the Free Software Foundation,                 *
17  *   Inc., 51 Franklin Street - Fifth Floor, Boston, MA 02110-1335, USA.   *
18  *                                                                         *
19  ***************************************************************************
20 
21   Author: Mattias Gaertner
22 
23   Abstract:
24     Running external programs and parsing their output lines.
25 }
26 unit ExtTools;
27 
28 {$mode objfpc}{$H+}
29 
30 {off $DEFINE VerboseExtToolErrors}
31 {off $DEFINE VerboseExtToolAddOutputLines}
32 {off $DEFINE VerboseExtToolThread}
33 
34 interface
35 
36 uses
37   // RTL + FCL
38   Classes, SysUtils, math, process, Pipes, Laz_AVL_Tree,
39   // LazUtils
40   FileUtil, LazFileUtils, LazUtilities, LazLoggerBase, UTF8Process, LazUTF8,
41   UITypes, AvgLvlTree,
42   // IDEIntf
43   IDEExternToolIntf, BaseIDEIntf, MacroIntf, LazMsgDialogs,
44   // IDE
45   IDECmdLine, TransferMacros, LazarusIDEStrConsts;
46 
47 type
48   TLMVToolState = (
49     lmvtsRunning,
50     lmvtsSuccess,
51     lmvtsFailed
52     );
53   TLMVToolStates = set of TLMVToolState;
54 
55   { TLazExtToolView }
56 
57   TLazExtToolView = class(TExtToolView)
58   private
59     FToolState: TLMVToolState;
60   protected
61     procedure SetToolState(AValue: TLMVToolState); virtual;
62   public
63     property ToolState: TLMVToolState read FToolState write SetToolState;
64   end;
65 
66   TExternalTool = class;
67 
68   { TExternalToolThread }
69 
70   TExternalToolThread = class(TThread)
71   private
72     fLines: TStringList;
73     FTool: TExternalTool;
74     procedure SetTool(AValue: TExternalTool);
75   public
76     property Tool: TExternalTool read FTool write SetTool;
77     procedure Execute; override;
78     procedure DebuglnThreadLog(const Args: array of const);
79     destructor Destroy; override;
80   end;
81 
82   { TExternalTool }
83 
84   TExternalTool = class(TAbstractExternalTool)
85   private
86     FThread: TExternalToolThread;
87     fExecuteAfter: TFPList; // list of TExternalTool
88     fExecuteBefore: TFPList; // list of TExternalTool
89     fNeedAfterSync: boolean;
90     fOutputCountNotified: integer;
91     procedure ProcessRunning; // (worker thread) after Process.Execute
92     procedure ProcessStopped; // (worker thread) when process stopped
93     procedure AddOutputLines(Lines: TStringList); // (worker thread) when new output arrived
94     procedure NotifyHandlerStopped; // (main thread) called by ProcessStopped
95     procedure NotifyHandlerNewOutput; // (main thread) called by AddOutputLines
96     procedure SetThread(AValue: TExternalToolThread); // main or worker thread
97     procedure SynchronizedImproveMessages; // (main thread) called by AddOutputLines
98     procedure DoTerminate; // (main thread)
99   protected
100     procedure DoExecute; override;           // (main thread)
101     procedure DoStart;                       // (main thread)
102     procedure CreateView; virtual; abstract; // (main thread)
GetExecuteAfternull103     function GetExecuteAfter(Index: integer): TAbstractExternalTool; override;
GetExecuteBeforenull104     function GetExecuteBefore(Index: integer): TAbstractExternalTool; override;
105     procedure Notification(AComponent: TComponent; Operation: TOperation); override;
CanFreenull106     function CanFree: boolean; override;
107     procedure QueueAsyncAutoFree; virtual; abstract;
108   public
109     constructor Create(aOwner: TComponent); override;
110     destructor Destroy; override;
111     property Thread: TExternalToolThread read FThread write SetThread;
112     procedure Execute; override;
113     procedure Terminate; override;
114     procedure WaitForExit; override;
ResolveMacrosnull115     function ResolveMacros: boolean; override;
116 
ExecuteAfterCountnull117     function ExecuteAfterCount: integer; override;
ExecuteBeforeCountnull118     function ExecuteBeforeCount: integer; override;
119     procedure RemoveExecuteBefore(Tool: TAbstractExternalTool); override;
IsExecutedBeforenull120     function IsExecutedBefore(Tool: TAbstractExternalTool): Boolean; override;
121     procedure AddExecuteBefore(Tool: TAbstractExternalTool); override;
CanStartnull122     function CanStart: boolean;
GetLongestEstimatedLoadnull123     function GetLongestEstimatedLoad: int64;
124   end;
125 
126   TExternalToolClass = class of TExternalTool;
127 
128   { TExternalTools }
129 
130   TExternalTools = class(TExternalToolsBase)
131   private
132     FCritSec: TRTLCriticalSection;
133     fRunning: TFPList; // list of TExternalTool, needs Enter/LeaveCriticalSection
134     FMaxProcessCount: integer;
135     fParsers: TFPList; // list of TExtToolParserClass
GetRunningToolsnull136     function GetRunningTools(Index: integer): TExternalTool;
137     procedure AddRunningTool(Tool: TExternalTool); // (worker thread)
138     procedure RemoveRunningTool(Tool: TExternalTool); // (worker thread)
RunExtToolHandlernull139     function RunExtToolHandler(ToolOptions: TIDEExternalToolOptions): boolean;
RunToolAndDetachnull140     function RunToolAndDetach(ToolOptions: TIDEExternalToolOptions): boolean;
RunToolWithParsersnull141     function RunToolWithParsers(ToolOptions: TIDEExternalToolOptions): boolean;
142   protected
143     FToolClass: TExternalToolClass;
GetParsersnull144     function GetParsers(Index: integer): TExtToolParserClass; override;
145     procedure Notification(AComponent: TComponent; Operation: TOperation); override;
146   public
147     constructor Create(aOwner: TComponent); override;
148     destructor Destroy; override;
Addnull149     function Add(Title: string): TAbstractExternalTool; override;
IndexOfnull150     function IndexOf(Tool: TAbstractExternalTool): integer; override;
151     property MaxProcessCount: integer read FMaxProcessCount write FMaxProcessCount;
152     procedure Work;
FindNextToolToStartnull153     function FindNextToolToStart: TExternalTool;
154     procedure Terminate(Tool: TExternalTool);
155     procedure TerminateAll; override;
156     procedure Clear; override;
RunningCountnull157     function RunningCount: integer;
158     property RunningTools[Index: integer]: TExternalTool read GetRunningTools;
159     procedure EnterCriticalSection; override;
160     procedure LeaveCriticalSection; override;
161     // parsers
ParserCountnull162     function ParserCount: integer; override;
163     procedure RegisterParser(Parser: TExtToolParserClass); override;
164     procedure UnregisterParser(Parser: TExtToolParserClass); override;
FindParserForToolnull165     function FindParserForTool(const SubTool: string): TExtToolParserClass; override;
FindParserWithNamenull166     function FindParserWithName(const ParserName: string): TExtToolParserClass;
167       override;
GetMsgToolnull168     function GetMsgTool(Msg: TMessageLine): TAbstractExternalTool; override;
169   end;
170 
171   TExternalToolsClass = class of TExternalTools;
172 
173 var
174   ExternalTools: TExternalTools = nil;
175 
176 implementation
177 
178 { TLazExtToolView }
179 
180 procedure TLazExtToolView.SetToolState(AValue: TLMVToolState);
181 begin
182   if FToolState=AValue then Exit;
183   FToolState:=AValue;
184 end;
185 
186 { TExternalTool }
187 
188 procedure TExternalTool.ProcessRunning;
189 var
190   i: Integer;
191 begin
192   EnterCriticalSection;
193   try
194     if FStage<>etsStarting then exit;
195     FStage:=etsRunning;
196   finally
197     LeaveCriticalSection;
198   end;
199   for i:=0 to ParserCount-1 do
200     Parsers[i].InitReading;
201 end;
202 
203 procedure TExternalTool.ProcessStopped;
204 var
205   i: Integer;
206 begin
207   {$IFDEF VerboseExtToolErrors}
208   if ErrorMessage<>'' then
209     DebuglnThreadLog(['TExternalTool.ThreadStopped ',Title,' ErrorMessage=',ErrorMessage]);
210   {$ENDIF}
211   EnterCriticalSection;
212   try
213     if (not Terminated) and (ErrorMessage='') then
214     begin
215       if ExitCode<>0 then
216         ErrorMessage:=Format(lisExitCode, [IntToStr(ExitCode)])
217       else if ExitStatus<>0 then
218         ErrorMessage:='ExitStatus '+IntToStr(ExitStatus);
219     end;
220     if FStage>=etsStopped then exit;
221     FStage:=etsStopped;
222   finally
223     LeaveCriticalSection;
224   end;
225   for i:=0 to ParserCount-1 do begin
226     try
227       Parsers[i].Done;
228     except
229       on E: Exception do begin
230         {$IFDEF VerboseExtToolErrors}
231         DebuglnThreadLog(['TExternalTool.ProcessStopped ',Title,' Error in ',DbgSName(Parsers[i]),': ',E.Message]);
232         {$ENDIF}
233       end;
234     end;
235   end;
236   try
237     if Tools<>nil then
238       TExternalTools(Tools).RemoveRunningTool(Self);
239     Thread.Synchronize(Thread,@NotifyHandlerStopped);
240   finally
241     fThread:=nil;
242   end;
243 end;
244 
245 procedure TExternalTool.AddOutputLines(Lines: TStringList);
246 var
247   i: Integer;
248   Handled: Boolean;
249   Line: LongInt;
250   OldOutputCount: LongInt;
251   OldMsgCount: LongInt;
252   Parser: TExtToolParser;
253   NeedSynchronize: Boolean;
254   MsgLine: TMessageLine;
255   LineStr: String;
256 begin
257   {$IFDEF VerboseExtToolAddOutputLines}
258   DebuglnThreadLog(['TExternalTool.AddOutputLines ',Title,' Tick=',IntToStr(GetTickCount64),' Lines=',Lines.Count]);
259   {$ENDIF}
260   if (Lines=nil) or (Lines.Count=0) then exit;
261   NeedSynchronize:=false;
262   EnterCriticalSection;
263   try
264     OldOutputCount:=WorkerOutput.Count;
265     OldMsgCount:=WorkerMessages.Count;
266     WorkerOutput.AddStrings(Lines);
267     for i:=0 to ParserCount-1 do
268       Parsers[i].NeedSynchronize:=false;
269 
270     // feed new lines into all parsers, converting raw lines into messages
271     for Line:=OldOutputCount to WorkerOutput.Count-1 do begin
272       Handled:=false;
273       LineStr:=WorkerOutput[Line];
274       for i:=0 to ParserCount-1 do begin
275         {$IFDEF VerboseExtToolAddOutputLines}
276         DebuglnThreadLog(['TExternalTool.AddOutputLines ',DbgSName(Parsers[i]),' Line="',WorkerOutput[Line],'" READLINE ...']);
277         {$ENDIF}
278         Parsers[i].ReadLine(LineStr,Line,Handled);
279         if Handled then break;
280       end;
281       if (not Handled) then begin
282         MsgLine:=WorkerMessages.CreateLine(Line);
283         MsgLine.Msg:=LineStr; // use raw output as default msg
284         MsgLine.Urgency:=mluDebug;
285         WorkerMessages.Add(MsgLine);
286       end;
287     end;
288 
289     // let all parsers improve the new messages
290     if OldMsgCount<WorkerMessages.Count then begin
291       for i:=0 to ParserCount-1 do begin
292         Parser:=Parsers[i];
293         Parser.NeedSynchronize:=false;
294         Parser.NeedAfterSync:=false;
295         {$IFDEF VerboseExtToolAddOutputLines}
296         DebuglnThreadLog(['TExternalTool.AddOutputLines ',DbgSName(Parser),' IMPROVE after ReadLine ...']);
297         {$ENDIF}
298         Parser.ImproveMessages(etpspAfterReadLine);
299         if Parser.NeedSynchronize then
300           NeedSynchronize:=true;
301       end;
302     end;
303   finally
304     LeaveCriticalSection;
305   end;
306 
307   // let all parsers improve the new messages
308   if NeedSynchronize then begin
309     {$IFDEF VerboseExtToolAddOutputLines}
310     DebuglnThreadLog(['TExternalTool.AddOutputLines SynchronizedImproveMessages ...']);
311     {$ENDIF}
312     Thread.Synchronize(Thread,@SynchronizedImproveMessages);
313   end;
314 
315   EnterCriticalSection;
316   try
317     if fNeedAfterSync then begin
318       for i:=0 to ParserCount-1 do begin
319         Parser:=Parsers[i];
320         if not Parser.NeedAfterSync then continue;
321         {$IFDEF VerboseExtToolAddOutputLines}
322         DebuglnThreadLog(['TExternalTool.AddOutputLines ',DbgSName(Parser),' IMPROVE after sync ...']);
323         {$ENDIF}
324         Parser.ImproveMessages(etpspAfterSync);
325       end;
326     end;
327 
328     // feed new messages into all viewers
329     if OldMsgCount<WorkerMessages.Count then begin
330       for i:=0 to ViewCount-1 do begin
331         {$IFDEF VerboseExtToolAddOutputLines}
332         DebuglnThreadLog(['TExternalTool.AddOutputLines ',DbgSName(Views[i]),' "',Views[i].Caption,'" ProcessNewMessages ...']);
333         {$ENDIF}
334         Views[i].ProcessNewMessages(Thread);
335       end;
336     end;
337   finally
338     LeaveCriticalSection;
339   end;
340 
341   // notify main thread handlers for new output
342   // Note: The IDE itself does not set such a handler
343   if {$IFDEF VerboseExtToolAddOutputLines}true{$ELSE}FHandlers[ethNewOutput].Count>0{$ENDIF}
344   then begin
345     {$IFDEF VerboseExtToolAddOutputLines}
346     DebuglnThreadLog(['TExternalTool.AddOutputLines NotifyHandlerNewOutput ...']);
347     {$ENDIF}
348     Thread.Synchronize(Thread,@NotifyHandlerNewOutput);
349   end;
350   fOutputCountNotified:=WorkerOutput.Count;
351   {$IFDEF VerboseExtToolAddOutputLines}
352   DebuglnThreadLog(['TExternalTool.AddOutputLines END']);
353   {$ENDIF}
354 end;
355 
356 procedure TExternalTool.NotifyHandlerStopped;
357 var
358   i: Integer;
359   View: TExtToolView;
360 begin
361   DoCallNotifyHandler(ethStopped);
362 
363   EnterCriticalSection;
364   try
365     for i:=ViewCount-1 downto 0 do begin
366       if i>=ViewCount then continue;
367       View:=Views[i];
368       if ErrorMessage<>'' then
369         View.SummaryMsg:=ErrorMessage
370       else
371         View.SummaryMsg:=lisSuccess;
372       View.InputClosed; // this might delete the view
373     end;
374   finally
375     LeaveCriticalSection;
376   end;
377 
378   if Group<>nil then
379     Group.ToolExited(Self);
380 
381   // process stopped => start next
382   if Tools<>nil then
383     TExternalTools(Tools).Work;
384 end;
385 
386 procedure TExternalTool.NotifyHandlerNewOutput;
387 var
388   i: integer;
389 begin
390   if fOutputCountNotified>=WorkerOutput.Count then exit;
391   {$IFDEF VerboseExtToolAddOutputLines}
392   for i:=fOutputCountNotified to WorkerOutput.Count-1 do
393     debugln('IDE-DEBUG: ',WorkerOutput[i]);
394   {$ENDIF}
395   i:=FHandlers[ethNewOutput].Count;
396   while FHandlers[ethNewOutput].NextDownIndex(i) do
397     TExternalToolNewOutputEvent(FHandlers[ethNewOutput][i])(Self,fOutputCountNotified);
398 end;
399 
400 procedure TExternalTool.SetThread(AValue: TExternalToolThread);
401 var
402   CallAutoFree: Boolean;
403 begin
404   // Note: in lazbuild ProcessStopped sets FThread:=nil, so SetThread is not called.
405   EnterCriticalSection;
406   try
407     if FThread=AValue then Exit;
408     FThread:=AValue;
409     CallAutoFree:=CanFree;
410   finally
411     LeaveCriticalSection;
412   end;
413   if CallAutoFree then begin
414     if MainThreadID=GetCurrentThreadId then
415       AutoFree
416     else
417       QueueAsyncAutoFree;
418   end;
419 end;
420 
421 procedure TExternalTool.SynchronizedImproveMessages;
422 var
423   i: Integer;
424   Parser: TExtToolParser;
425 begin
426   EnterCriticalSection;
427   try
428     fNeedAfterSync:=false;
429     for i:=0 to ParserCount-1 do begin
430       Parser:=Parsers[i];
431       if not Parser.NeedSynchronize then continue;
432       {$IFDEF VerboseExtToolAddOutputLines}
433       //debugln(['TExternalTool.SynchronizedImproveMessages ',DbgSName(Parser),' ...']);
434       {$ENDIF}
435       Parser.ImproveMessages(etpspSynchronized);
436       Parser.NeedSynchronize:=false;
437       if Parser.NeedAfterSync then
438         fNeedAfterSync:=true;
439     end;
440   finally
441     LeaveCriticalSection;
442   end;
443 end;
444 
445 constructor TExternalTool.Create(aOwner: TComponent);
446 begin
447   inherited Create(aOwner);
448   FWorkerOutput:=TStringList.Create;
449   FProcess:=TProcessUTF8.Create(nil);
450   FProcess.Options:= [poUsePipes{$IFDEF Windows},poStderrToOutPut{$ENDIF}];
451   FProcess.ShowWindow := swoHide;
452   fExecuteBefore:=TFPList.Create;
453   fExecuteAfter:=TFPList.Create;
454 end;
455 
456 destructor TExternalTool.Destroy;
457 begin
458   //debugln(['TExternalTool.Destroy ',Title]);
459   EnterCriticalSection;
460   try
461     FStage:=etsDestroying;
462     if Thread is TExternalToolThread then
463       TExternalToolThread(Thread).Tool:=nil;
464     FreeAndNil(FProcess);
465     FreeAndNil(FWorkerOutput);
466     FreeAndNil(fExecuteBefore);
467     FreeAndNil(fExecuteAfter);
468   finally
469     LeaveCriticalSection;
470   end;
471   inherited Destroy;
472 end;
473 
474 procedure TExternalTool.DoExecute;
475 // in main thread
476 
CheckErrornull477   function CheckError: boolean;
478   begin
479     if (FStage>=etsStopped) then exit(true);
480     if (ErrorMessage='') then exit(false);
481     debugln(['Error: (lazarus) [TExternalTool.DoExecute.CheckError] Error=',ErrorMessage]);
482     EnterCriticalSection;
483     try
484       if FStage>=etsStopped then exit(true);
485       FStage:=etsStopped;
486     finally
487       LeaveCriticalSection;
488     end;
489     CreateView;
490     NotifyHandlerStopped;
491 
492     Result:=true;
493   end;
494 
495 var
496   ExeFile: String;
497   i: Integer;
498   aParser: TExtToolParser;
499 begin
500   if Terminated then exit;
501 
502   // set Stage to etsInitializing
503   EnterCriticalSection;
504   try
505     if Stage<>etsInit then
506       raise Exception.Create('TExternalTool.Execute: already initialized');
507     FStage:=etsInitializing;
508   finally
509     LeaveCriticalSection;
510   end;
511 
512   // resolve macros
513   if ResolveMacrosOnExecute then
514   begin
515     if not ResolveMacros then begin
516       if ErrorMessage='' then
517         ErrorMessage:=lisFailedToResolveMacros;
518       if CheckError then exit;
519     end;
520   end;
521 
522   // init CurrentDirectory
523   Process.CurrentDirectory:=TrimFilename(Process.CurrentDirectory);
524   if not FilenameIsAbsolute(Process.CurrentDirectory) then
525     Process.CurrentDirectory:=AppendPathDelim(GetCurrentDirUTF8)+Process.CurrentDirectory;
526 
527   // init Executable
528   Process.Executable:=TrimFilename(Process.Executable);
529   {$IFDEF VerboseExtToolThread}
530   debugln(['TExternalTool.DoExecute Exe=',Process.Executable]);
531   {$ENDIF}
532   if not FilenameIsAbsolute(Process.Executable) then begin
533     if ExtractFilePath(Process.Executable)<>'' then
534       Process.Executable:=AppendPathDelim(GetCurrentDirUTF8)+Process.Executable
535     else if Process.Executable='' then begin
536       ErrorMessage:=Format(lisToolHasNoExecutable, [Title]);
537       CheckError;
538       exit;
539     end else begin
540       ExeFile:=FindDefaultExecutablePath(Process.Executable,GetCurrentDirUTF8);
541       if ExeFile='' then begin
542         ErrorMessage:=Format(lisCanNotFindExecutable, [Process.Executable]);
543         CheckError;
544         exit;
545       end;
546       Process.Executable:=ExeFile;
547     end;
548   end;
549   ExeFile:=Process.Executable;
550   if not FileExistsUTF8(ExeFile) then begin
551     ErrorMessage:=Format(lisMissingExecutable, [ExeFile]);
552     CheckError;
553     exit;
554   end;
555   if DirectoryExistsUTF8(ExeFile) then begin
556     ErrorMessage:=Format(lisExecutableIsADirectory, [ExeFile]);
557     CheckError;
558     exit;
559   end;
560   if not FileIsExecutable(ExeFile) then begin
561     ErrorMessage:=Format(lisExecutableLacksThePermissionToRun, [ExeFile]);
562     CheckError;
563     exit;
564   end;
565 
566   // init misc
567   WorkerMessages.BaseDirectory:=Process.CurrentDirectory;
568   WorkerDirectory:=WorkerMessages.BaseDirectory;
569   if EnvironmentOverrides.Count>0 then
570     AssignEnvironmentTo(Process.Environment,EnvironmentOverrides);
571 
572   // init parsers
573   for i:=0 to ParserCount-1 do begin
574     aParser:=Parsers[i];
575     try
576       aParser.Init;
577     except
578       on E: Exception do begin
579         ErrorMessage:=Format(lisParser, [DbgSName(aParser), E.Message]);
580         CheckError;
581         exit;
582       end;
583     end;
584   end;
585 
586   // set Stage to etsWaitingForStart
587   EnterCriticalSection;
588   try
589     if Stage<>etsInitializing then
590       raise Exception.Create('TExternalTool.Execute: bug in initialization');
591     FStage:=etsWaitingForStart;
592   finally
593     LeaveCriticalSection;
594   end;
595 end;
596 
597 procedure TExternalTool.DoStart;
598 var
599   i: Integer;
600 begin
601   // set Stage to etsStarting
602   EnterCriticalSection;
603   try
604     if Stage<>etsWaitingForStart then
605       raise Exception.Create('TExternalTool.Execute: already started');
606     FStage:=etsStarting;
607   finally
608     LeaveCriticalSection;
609   end;
610 
611   CreateView;
612 
613   // mark running
614   if Tools<>nil then
615     TExternalTools(Tools).AddRunningTool(Self);
616 
617   // start thread
618   if Thread=nil then begin
619     FThread:=TExternalToolThread.Create(true);
620     Thread.Tool:=Self;
621     FThread.FreeOnTerminate:=true;
622   end;
623   if ConsoleVerbosity>=-1 then begin
624     debugln(['Info: (lazarus) Execute Title="',Title,'"']);
625     debugln(['Info: (lazarus) Working Directory="',Process.CurrentDirectory,'"']);
626     debugln(['Info: (lazarus) Executable="',Process.Executable,'"']);
627     for i:=0 to Process.Parameters.Count-1 do
628       debugln(['Info: (lazarus) Param[',i,']="',Process.Parameters[i],'"']);
629   end;
630   Thread.Start;
631 end;
632 
ExecuteBeforeCountnull633 function TExternalTool.ExecuteBeforeCount: integer;
634 begin
635   Result:=fExecuteBefore.Count;
636 end;
637 
TExternalTool.ExecuteAfterCountnull638 function TExternalTool.ExecuteAfterCount: integer;
639 begin
640   Result:=fExecuteAfter.Count;
641 end;
642 
GetExecuteAfternull643 function TExternalTool.GetExecuteAfter(Index: integer): TAbstractExternalTool;
644 begin
645   Result:=TAbstractExternalTool(fExecuteAfter[Index]);
646 end;
647 
GetExecuteBeforenull648 function TExternalTool.GetExecuteBefore(Index: integer): TAbstractExternalTool;
649 begin
650   Result:=TAbstractExternalTool(fExecuteBefore[Index]);
651 end;
652 
653 procedure TExternalTool.DoTerminate;
654 var
655   NeedProcTerminate: Boolean;
656 begin
657   NeedProcTerminate:=false;
658   EnterCriticalSection;
659   try
660     //debugln(['TExternalTool.DoTerminate ',Title,' Terminated=',Terminated,' Stage=',dbgs(Stage)]);
661     if Terminated then exit;
662     if Stage=etsStopped then exit;
663 
664     if ErrorMessage='' then
665       ErrorMessage:=lisAborted;
666     fTerminated:=true;
667     if Stage=etsRunning then
668       NeedProcTerminate:=true;
669     if Stage<etsStarting then
670       FStage:=etsStopped
671     else if Stage<=etsRunning then
672       FStage:=etsWaitingForStop;
673   finally
674     LeaveCriticalSection;
675   end;
676   if NeedProcTerminate and (Process<>nil) then
677     Process.Terminate(AbortedExitCode);
678 end;
679 
680 procedure TExternalTool.Notification(AComponent: TComponent; Operation: TOperation);
681 begin
682   inherited Notification(AComponent, Operation);
683   if Operation=opRemove then begin
684     if fExecuteBefore<>nil then
685       fExecuteBefore.Remove(AComponent);
686     if fExecuteAfter<>nil then
687       fExecuteAfter.Remove(AComponent);
688   end;
689 end;
690 
TExternalTool.CanFreenull691 function TExternalTool.CanFree: boolean;
692 begin
693   Result:=(FThread=nil)
694        and inherited CanFree;
695 end;
696 
IsExecutedBeforenull697 function TExternalTool.IsExecutedBefore(Tool: TAbstractExternalTool): Boolean;
698 var
699   Visited: TFPList;
700 
Searchnull701   function Search(CurTool: TAbstractExternalTool): Boolean;
702   var
703     i: Integer;
704   begin
705     if CurTool=Tool then exit(true);
706     if Visited.IndexOf(CurTool)>=0 then exit(false);
707     Visited.Add(CurTool);
708     for i:=0 to CurTool.ExecuteBeforeCount-1 do
709       if Search(CurTool.ExecuteBefore[i]) then exit(true);
710     Result:=false;
711   end;
712 
713 begin
714   Result:=false;
715   if Tool=Self then exit;
716   Visited:=TFPList.Create;
717   try
718     Result:=Search(Self);
719   finally
720     Visited.Free;
721   end;
722 end;
723 
724 procedure TExternalTool.AddExecuteBefore(Tool: TAbstractExternalTool);
725 begin
726   //debugln(['TExternalTool.AddExecuteBefore Self=',Title,' Tool=',Tool.Title]);
727   if (Tool=Self) or (Tool.IsExecutedBefore(Self)) then
728     raise Exception.Create('TExternalTool.AddExecuteBefore: that would create a circle');
729   if (fExecuteBefore<>nil) and (fExecuteBefore.IndexOf(Tool)<0) then
730     fExecuteBefore.Add(Tool);
731   if (TExternalTool(Tool).fExecuteAfter<>nil)
732   and (TExternalTool(Tool).fExecuteAfter.IndexOf(Self)<=0) then
733     TExternalTool(Tool).fExecuteAfter.Add(Self);
734 end;
735 
TExternalTool.CanStartnull736 function TExternalTool.CanStart: boolean;
737 var
738   i: Integer;
739   ExecBefore: TAbstractExternalTool;
740 begin
741   Result:=false;
742   //debugln(['TExternalTool.CanStart ',Title,' ',dbgs(Stage)]);
743   if Stage<>etsWaitingForStart then exit;
744   if Terminated then exit;
745   for i:=0 to ExecuteBeforeCount-1 do begin
746     ExecBefore:=ExecuteBefore[i];
747     if ord(ExecBefore.Stage)<ord(etsStopped) then exit;
748     if ExecBefore.ErrorMessage<>'' then exit;
749   end;
750   Result:=true;
751 end;
752 
TExternalTool.GetLongestEstimatedLoadnull753 function TExternalTool.GetLongestEstimatedLoad: int64;
754 type
755   TInfo = record
756     Load: int64;
757   end;
758   PInfo = ^TInfo;
759 var
760   ToolToInfo: TPointerToPointerTree;
761 
GetLoadnull762   function GetLoad(Tool: TExternalTool): int64;
763   var
764     Info: PInfo;
765     i: Integer;
766   begin
767     Info:=PInfo(ToolToInfo[Tool]);
768     if Info<>nil then
769       Result:=Info^.Load
770     else begin
771       New(Info);
772       Info^.Load:=1;
773       ToolToInfo[Tool]:=Info;
774       Result:=0;
775       for i:=0 to Tool.ExecuteAfterCount-1 do
776         Result:=Max(Result,GetLoad(TExternalTool(Tool.ExecuteAfter[i])));
777       inc(Result,Tool.EstimatedLoad);
778       Info^.Load:=Result;
779     end;
780   end;
781 
782 var
783   Node: TAvlTreeNode;
784   Item: PPointerToPointerItem;
785   Info: PInfo;
786 begin
787   ToolToInfo:=TPointerToPointerTree.Create;
788   try
789     Result:=GetLoad(Self);
790   finally
791     Node:=ToolToInfo.Tree.FindLowest;
792     while Node<>nil do begin
793       Item:=PPointerToPointerItem(Node.Data);
794       Info:=PInfo(Item^.Value);
795       Dispose(Info);
796       Node:=ToolToInfo.Tree.FindSuccessor(Node);
797     end;
798     ToolToInfo.Free;
799   end;
800 end;
801 
802 procedure TExternalTool.Execute;
803 begin
804   if Stage<>etsInit then
805     raise Exception.Create('TExternalTool.Execute "'+Title+'" already started');
806   DoExecute;
807   if Stage<>etsWaitingForStart then
808     exit;
809 
810   if Tools<>nil then
811     TExternalTools(Tools).Work
812   else
813     DoStart;
814 end;
815 
816 procedure TExternalTool.Terminate;
817 begin
818   if Tools<>nil then
819     TExternalTools(Tools).Terminate(Self)
820   else
821     DoTerminate;
822 end;
823 
824 procedure TExternalTool.WaitForExit;
825 var
826   MyTools: TExternalToolsBase;
827 begin
828   MyTools:=Tools;
829   repeat
830     EnterCriticalSection;
831     try
832       if Stage=etsDestroying then exit;
833       if (Stage=etsStopped) and (FindUnfinishedView=nil) then exit;
834     finally
835       LeaveCriticalSection;
836     end;
837     // call synchronized tasks, this might free this tool
838     if MainThreadID=ThreadID then
839     begin
840       Assert(Owner is TExternalToolsBase, 'TExternalTool.WaitForExit: Owner is not TExternalToolsBase.');
841       TExternalToolsBase(Owner).HandleMesages;
842     end;
843     // check if this tool still exists
844     if MyTools.IndexOf(Self)<0 then exit;
845     // still running => wait
846     Sleep(10);
847   until false;
848 end;
849 
TExternalTool.ResolveMacrosnull850 function TExternalTool.ResolveMacros: boolean;
851 
Resolvenull852   function Resolve(const aValue: string; out NewValue: string): boolean;
853   begin
854     NewValue:=aValue;
855     Result:=IDEMacros.SubstituteMacros(NewValue);
856     if Result then exit;
857     if ErrorMessage='' then
858       ErrorMessage:=Format(lisInvalidMacrosIn, [aValue]);
859     LazMessageDialog(lisCCOErrorCaption, Format(lisInvalidMacrosInExternalTool,
860       [aValue, Title]),
861       mtError,[mbCancel]);
862   end;
863 
864 var
865   i: Integer;
866   s: string;
867 begin
868   if IDEMacros=nil then exit(true);
869   Result:=false;
870 
871   if not Resolve(Process.CurrentDirectory,s) then exit;
872   Process.CurrentDirectory:=s;
873 
874   if not Resolve(Process.Executable,s) then exit;
875   Process.Executable:=s;
876 
877   for i:=0 to Process.Parameters.Count-1 do begin
878     if not Resolve(Process.Parameters[i],s) then exit;
879     Process.Parameters[i]:=s;
880   end;
881 
882   for i:=0 to EnvironmentOverrides.Count-1 do begin
883     if not Resolve(EnvironmentOverrides[i],s) then exit;
884     EnvironmentOverrides[i]:=s;
885   end;
886 
887   Result:=true;
888 end;
889 
890 procedure TExternalTool.RemoveExecuteBefore(Tool: TAbstractExternalTool);
891 begin
892   if fExecuteBefore<>nil then
893     fExecuteBefore.Remove(Tool);
894   if TExternalTool(Tool).fExecuteAfter<>nil then
895     TExternalTool(Tool).fExecuteAfter.Remove(Self);
896 end;
897 
898 { TExternalTools }
899 
RunExtToolHandlernull900 function TExternalTools.RunExtToolHandler(ToolOptions: TIDEExternalToolOptions): boolean;
901 begin
902   {$IFDEF VerboseExtToolThread}
903   debugln(['TExternalTools.RunExtToolHandler ',ToolOptions.Title,
904            ' exe="',ToolOptions.Executable,'" params="',ToolOptions.CmdLineParams,'"']);
905   {$ENDIF}
906   if ToolOptions.Parsers.Count=0 then
907     Result := RunToolAndDetach(ToolOptions)
908   else
909     Result := RunToolWithParsers(ToolOptions)
910 end;
911 
RunToolAndDetachnull912 function TExternalTools.RunToolAndDetach(ToolOptions: TIDEExternalToolOptions): boolean;
913 // simply run and detach
914 var
915   i: Integer;
916   Proc: TProcessUTF8;
917   sl: TStringList;
918   s, Path: String;
919 begin
920   Result:=false;
921   Proc:=TProcessUTF8.Create(nil);
922   try
923     Proc.InheritHandles:=false;
924     // working directory
925     s:=ToolOptions.WorkingDirectory;
926     if ToolOptions.ResolveMacros then begin
927       if not GlobalMacroList.SubstituteStr(s) then begin
928         debugln(['Error: (lazarus) [TExternalTools.RunToolAndDetach] ',ToolOptions.Title,' failed: macros of WorkerDirectory: "',ToolOptions.WorkingDirectory,'"']);
929         exit;
930       end;
931     end;
932     s:=ChompPathDelim(CleanAndExpandDirectory(s));
933     if not DirectoryExistsUTF8(s) then begin
934       debugln(['Error: (lazarus) [TExternalTools.RunToolAndDetach] ',ToolOptions.Title,' failed: missing directory "',s,'"']);
935       exit;
936     end;
937     Proc.CurrentDirectory:=s;
938 
939     // environment
940     if ToolOptions.EnvironmentOverrides.Count>0 then
941       AssignEnvironmentTo(Proc.Environment,ToolOptions.EnvironmentOverrides);
942     if ToolOptions.ResolveMacros then begin
943       for i:=0 to Proc.Environment.Count-1 do begin
944         s:=Proc.Environment[i];
945         if not GlobalMacroList.SubstituteStr(s) then begin
946           debugln(['Error: (lazarus) [TExternalTools.RunToolAndDetach] ',ToolOptions.Title,' failed: environment override "',Proc.Environment,'"']);
947           exit;
948         end;
949         Proc.Environment[i]:=s;
950       end;
951     end;
952 
953     // executable
954     s:=ToolOptions.Executable;
955     if ToolOptions.ResolveMacros then begin
956       if not GlobalMacroList.SubstituteStr(s) then begin
957         debugln(['Error: (lazarus) [TExternalTools.RunToolAndDetach] ',ToolOptions.Title,' failed: macros of Executable: "',ToolOptions.Executable,'"']);
958         exit;
959       end;
960     end;
961     if not FilenameIsAbsolute(s) then begin
962       // search in PATH
963       if Proc.Environment.Count>0 then
964         Path:=Proc.Environment.Values['PATH']
965       else
966         Path:=GetEnvironmentVariableUTF8('PATH');
967       s:=SearchFileInPath(s,Proc.CurrentDirectory,
968                                Path, PathSeparator,
969                                []);
970       {$IFDEF Windows}
971       if (s='') and (ExtractFileExt(s)='') then begin
972         s:=SearchFileInPath(s+'.exe',Proc.CurrentDirectory,
973                                  Path, PathSeparator,
974                                  []);
975       end;
976       {$ENDIF}
977       if s='' then begin
978         debugln(['Error: (lazarus) [TExternalTools.RunToolAndDetach] ',ToolOptions.Title,' failed: missing executable "',ToolOptions.Executable,'"']);
979         exit;
980       end;
981     end;
982     if not ( FilenameIsAbsolute(s) and FileExistsUTF8(s) ) then begin
983       debugln(['Error: (lazarus) [TExternalTools.RunToolAndDetach] ',ToolOptions.Title,'  failed: missing executable: "',s,'"']);
984       exit;
985     end;
986     if DirectoryExistsUTF8(s) {$IFDEF DARWIN}and (ExtractFileExt(s)<>'.app'){$ENDIF} then begin
987       debugln(['Error: (lazarus) [TExternalTools.RunToolAndDetach] ',ToolOptions.Title,'  failed: executable is a directory: "',s,'"']);
988       exit;
989     end;
990     if {$IFDEF DARWIN}(ExtractFileExt(s)<>'.app') and{$ENDIF} not FileIsExecutable(s) then begin
991       debugln(['Error: (lazarus) [TExternalTools.RunToolAndDetach] ',ToolOptions.Title,'  failed: executable lacks permission to run: "',s,'"']);
992       exit;
993     end;
994 
995     {$IFDEF DARWIN}
996     if DirectoryExistsUTF8(s) then
997     begin
998       Proc.Executable:='/usr/bin/open';
999       s:=s+LineEnding+ToolOptions.CmdLineParams;
1000     end
1001     else
1002     {$ENDIF}
1003     begin
1004       Proc.Executable:=s;
1005       s:=ToolOptions.CmdLineParams;
1006     end;
1007 
1008     // params
1009     if ToolOptions.ResolveMacros and not GlobalMacroList.SubstituteStr(s) then begin
1010       debugln(['Error: (lazarus) [TExternalTools.RunToolAndDetach] ',ToolOptions.Title,
1011                ' failed: macros in cmd line params "',ToolOptions.CmdLineParams,'"']);
1012       exit;
1013     end;
1014     sl:=TStringList.Create;
1015     try
1016       SplitCmdLineParams(s,sl);
1017       Proc.Parameters:=sl;
1018     finally
1019       sl.Free;
1020     end;
1021 
1022     // run and detach
1023     if ToolOptions.ShowConsole then
1024       Proc.Options:=Proc.Options+[poNewConsole]-[poNoConsole]
1025     else
1026       Proc.Options:=Proc.Options-[poNewConsole]+[poNoConsole];
1027     if ToolOptions.HideWindow then
1028       Proc.ShowWindow:=swoHide
1029     else
1030       Proc.ShowWindow:=swoShow;
1031     try
1032       Proc.Execute;
1033       Result:=true;
1034     except
1035     end;
1036   finally
1037     Proc.Free;
1038   end;
1039 end;
1040 
RunToolWithParsersnull1041 function TExternalTools.RunToolWithParsers(ToolOptions: TIDEExternalToolOptions): boolean;
1042 // run with parsers and messages
1043 var
1044   Tool: TAbstractExternalTool;
1045   i: Integer;
1046 begin
1047   {$IFDEF VerboseExtToolThread}
1048   debugln(['TExternalTools.RunToolWithParsers run with scanners ...']);
1049   {$ENDIF}
1050   Result:=false;
1051   Tool:=Add(ToolOptions.Title);
1052   Tool.Reference(Self,ClassName);
1053   try
1054     Tool.Hint:=ToolOptions.Hint;
1055     Tool.Process.CurrentDirectory:=ToolOptions.WorkingDirectory;
1056     Tool.Process.Executable:=ToolOptions.Executable;
1057     Tool.CmdLineParams:=ToolOptions.CmdLineParams;
1058     Tool.EnvironmentOverrides:=ToolOptions.EnvironmentOverrides;
1059     Assert(Assigned(ToolOptions.Parsers), 'TExternalTools.RunToolWithParsers: Parsers=Nil.');
1060     for i:=0 to ToolOptions.Parsers.Count-1 do
1061       Tool.AddParsers(ToolOptions.Parsers[i]);
1062     if ToolOptions.ShowConsole then
1063       Tool.Process.Options:=Tool.Process.Options+[poNewConsole]-[poNoConsole]
1064     else
1065       Tool.Process.Options:=Tool.Process.Options-[poNewConsole]+[poNoConsole];
1066     if ToolOptions.HideWindow then
1067       Tool.Process.ShowWindow:=swoHide
1068     else
1069       Tool.Process.ShowWindow:=swoShow;
1070     if ToolOptions.ResolveMacros and not Tool.ResolveMacros then begin
1071       debugln(['Error: (lazarus) [TExternalTools.RunToolWithParsers] failed to resolve macros']);
1072       exit;
1073     end;
1074     {$IFDEF VerboseExtToolThread}
1075     debugln(['TExternalTools.RunToolWithParsers Execute ',Tool.Title,' WD="',Tool.Process.CurrentDirectory,'" Exe="',Tool.Process.Executable,'" Params="',Tool.CmdLineParams,'" ...']);
1076     {$ENDIF}
1077     Tool.Execute;
1078     {$IFDEF VerboseExtToolThread}
1079     debugln(['TExternalTools.RunToolWithParsers WaitForExit ',Tool.Title,' ...']);
1080     {$ENDIF}
1081     Tool.WaitForExit;
1082     {$IFDEF VerboseExtToolThread}
1083     debugln(['TExternalTools.RunToolWithParsers Done ',Tool.Title]);
1084     {$ENDIF}
1085     Result:=(Tool.ErrorMessage='') and (not Tool.Terminated) and (Tool.ExitStatus=0);
1086   finally
1087     Tool.Release(Self);
1088   end;
1089 end;
1090 
TExternalTools.GetRunningToolsnull1091 function TExternalTools.GetRunningTools(Index: integer): TExternalTool;
1092 begin
1093   EnterCriticalSection;
1094   try
1095     Result:=TExternalTool(fRunning[Index]);
1096   finally
1097     LeaveCriticalSection;
1098   end;
1099 end;
1100 
1101 procedure TExternalTools.AddRunningTool(Tool: TExternalTool);
1102 begin
1103   EnterCriticalSection;
1104   try
1105     if fRunning.IndexOf(Tool)<0 then
1106       fRunning.Add(Tool);
1107   finally
1108     LeaveCriticalSection;
1109   end;
1110 end;
1111 
1112 procedure TExternalTools.RemoveRunningTool(Tool: TExternalTool);
1113 begin
1114   EnterCriticalSection;
1115   try
1116     fRunning.Remove(Tool);
1117   finally
1118     LeaveCriticalSection;
1119   end;
1120 end;
1121 
GetParsersnull1122 function TExternalTools.GetParsers(Index: integer): TExtToolParserClass;
1123 begin
1124   Result:=TExtToolParserClass(fParsers[Index]);
1125 end;
1126 
1127 procedure TExternalTools.Notification(AComponent: TComponent; Operation: TOperation);
1128 begin
1129   inherited Notification(AComponent, Operation);
1130   if Operation=opRemove then begin
1131     EnterCriticalSection;
1132     try
1133       if fItems<>nil then
1134         fItems.Remove(AComponent);
1135       if fRunning<>nil then
1136         fRunning.Remove(AComponent);
1137     finally
1138       LeaveCriticalSection;
1139     end;
1140   end;
1141 end;
1142 
1143 constructor TExternalTools.Create(aOwner: TComponent);
1144 begin
1145   inherited Create(aOwner);
1146   InitCriticalSection(FCritSec);
1147   fRunning:=TFPList.Create;
1148   fParsers:=TFPList.Create;
1149   MaxProcessCount:=DefaultMaxProcessCount;
1150   if ExternalToolList=nil then
1151     ExternalToolList:=Self;
1152   if ExternalTools=nil then
1153     ExternalTools:=Self;
1154   RunExternalTool := @RunExtToolHandler;
1155 end;
1156 
1157 destructor TExternalTools.Destroy;
1158 begin
1159   RunExternalTool:=nil;
1160   TerminateAll;
1161   EnterCriticalSection;
1162   try
1163     if fRunning.Count>0 then
1164       raise Exception.Create('TExternalTools.Destroy some tools still running');
1165     if ExternalToolList=Self then
1166       ExternalToolList:=nil;
1167     if ExternalTools=Self then
1168       ExternalTools:=nil;
1169     inherited Destroy;
1170     FreeAndNil(fRunning);
1171     FreeAndNil(fParsers);
1172   finally
1173     LeaveCriticalSection;
1174   end;
1175   DoneCriticalsection(FCritSec);
1176 end;
1177 
Addnull1178 function TExternalTools.Add(Title: string): TAbstractExternalTool;
1179 begin
1180   Result:=FToolClass.Create(Self);
1181   Result.Title:=Title;
1182   fItems.Add(Result);
1183 end;
1184 
IndexOfnull1185 function TExternalTools.IndexOf(Tool: TAbstractExternalTool): integer;
1186 begin
1187   Result:=fItems.IndexOf(Tool);
1188 end;
1189 
TExternalTools.ParserCountnull1190 function TExternalTools.ParserCount: integer;
1191 begin
1192   Result:=fParsers.Count;
1193 end;
1194 
1195 procedure TExternalTools.Work;
1196 var
1197   Tool: TExternalTool;
1198 begin
1199   while RunningCount<MaxProcessCount do begin
1200     Tool:=FindNextToolToStart;
1201     if Tool=nil then exit;
1202     Tool.DoStart;
1203   end;
1204 end;
1205 
TExternalTools.FindNextToolToStartnull1206 function TExternalTools.FindNextToolToStart: TExternalTool;
1207 var
1208   Tool: TExternalTool;
1209   CurLoad: Int64;
1210   Load: Int64;
1211   i: Integer;
1212 begin
1213   Result:=nil;
1214   Load:=0;
1215   for i:=0 to Count-1 do begin
1216     Tool:=TExternalTool(Items[i]);
1217     //debugln(['TExternalTools.FindNextToolToExec ',Tool.Title,' ',Tool.CanStart]);
1218     if not Tool.CanStart then continue;
1219     CurLoad:=Tool.GetLongestEstimatedLoad;
1220     if (Result<>nil) and (Load>=CurLoad) then Continue;
1221     Result:=Tool;
1222     Load:=CurLoad;
1223   end;
1224 end;
1225 
1226 procedure TExternalTools.Terminate(Tool: TExternalTool);
1227 begin
1228   if Tool=nil then exit;
1229   Tool.DoTerminate;
1230 end;
1231 
1232 procedure TExternalTools.TerminateAll;
1233 // terminate all current tools
1234 var
1235   i: Integer;
1236 begin
1237   for i:=Count-1 downto 0 do
1238   begin
1239     Assert(i<Count, 'TExternalTools.TerminateAll: xxx'); // if i>=Count then continue;  <- why was this?
1240     Terminate(Items[i] as TExternalTool);
1241   end;
1242 end;
1243 
1244 procedure TExternalTools.Clear;
1245 begin
1246   TerminateAll;
1247   while Count>0 do
1248     Items[0].Free;
1249 end;
1250 
RunningCountnull1251 function TExternalTools.RunningCount: integer;
1252 begin
1253   Result:=fRunning.Count;
1254 end;
1255 
1256 procedure TExternalTools.EnterCriticalSection;
1257 begin
1258   System.EnterCriticalsection(FCritSec);
1259 end;
1260 
1261 procedure TExternalTools.LeaveCriticalSection;
1262 begin
1263   System.LeaveCriticalsection(FCritSec);
1264 end;
1265 
1266 procedure TExternalTools.RegisterParser(Parser: TExtToolParserClass);
1267 begin
1268   if fParsers.IndexOf(Parser)>=0 then exit;
1269   fParsers.Add(Parser);
1270 end;
1271 
1272 procedure TExternalTools.UnregisterParser(Parser: TExtToolParserClass);
1273 begin
1274   if fParsers=nil then exit;
1275   fParsers.Remove(Parser);
1276 end;
1277 
TExternalTools.FindParserForToolnull1278 function TExternalTools.FindParserForTool(const SubTool: string): TExtToolParserClass;
1279 var
1280   i: Integer;
1281 begin
1282   for i:=0 to fParsers.Count-1 do begin
1283     Result:=TExtToolParserClass(fParsers[i]);
1284     if Result.CanParseSubTool(SubTool) then exit;
1285   end;
1286   Result:=nil;
1287 end;
1288 
TExternalTools.FindParserWithNamenull1289 function TExternalTools.FindParserWithName(const ParserName: string): TExtToolParserClass;
1290 var
1291   i: Integer;
1292 begin
1293   for i:=0 to fParsers.Count-1 do begin
1294     Result:=TExtToolParserClass(fParsers[i]);
1295     if SameText(Result.GetParserName,ParserName) then exit;
1296   end;
1297   Result:=nil;
1298 end;
1299 
GetMsgToolnull1300 function TExternalTools.GetMsgTool(Msg: TMessageLine): TAbstractExternalTool;
1301 var
1302   CurOwner: TObject;
1303   View: TExtToolView;
1304 begin
1305   Result:=nil;
1306   if (Msg=nil) or (Msg.Lines=nil) then exit;
1307   CurOwner:=Msg.Lines.Owner;
1308   if CurOwner=nil then exit;
1309   if CurOwner is TAbstractExternalTool then
1310     Result:=TAbstractExternalTool(CurOwner)
1311   else if CurOwner is TExtToolView then begin
1312     View:=TExtToolView(CurOwner);
1313     Result:=View.Tool;
1314   end;
1315 end;
1316 
1317 { TExternalToolThread }
1318 
1319 procedure TExternalToolThread.SetTool(AValue: TExternalTool);
1320 begin
1321   if FTool=AValue then Exit;
1322   if FTool<>nil then
1323     FTool.Thread:=nil;
1324   FTool:=AValue;
1325   if FTool<>nil then
1326     FTool.Thread:=Self;
1327 end;
1328 
1329 procedure TExternalToolThread.Execute;
1330 type
1331   TErrorFrame = record
1332     Addr: Pointer;
1333     Line: shortstring;
1334   end;
1335   PErrorFrame = ^TErrorFrame;
1336 
1337 var
1338   ErrorFrames: array[0..30] of TErrorFrame;
1339   ErrorFrameCount: integer;
1340 
GetExceptionStackTracenull1341   function GetExceptionStackTrace: string;
1342   var
1343     FrameCount: LongInt;
1344     Frames: PPointer;
1345     Cnt: LongInt;
1346     f: PErrorFrame;
1347     i: Integer;
1348   begin
1349     Result:='';
1350     FrameCount:=ExceptFrameCount;
1351     Frames:=ExceptFrames;
1352     ErrorFrames[0].Addr:=ExceptAddr;
1353     ErrorFrames[0].Line:='';
1354     ErrorFrameCount:=1;
1355     Cnt:=FrameCount;
1356     for i:=1 to Cnt do begin
1357       ErrorFrames[i].Addr:=Frames[i-1];
1358       ErrorFrames[i].Line:='';
1359       ErrorFrameCount:=i+1;
1360     end;
1361     for i:=0 to ErrorFrameCount-1 do begin
1362       f:=@ErrorFrames[i];
1363       try
1364         f^.Line:=copy(BackTraceStrFunc(f^.Addr),1,255);
1365       except
1366         f^.Line:=copy(SysBackTraceStr(f^.Addr),1,255);
1367       end;
1368     end;
1369     for i:=0 to ErrorFrameCount-1 do begin
1370       Result+=ErrorFrames[i].Line+LineEnding;
1371     end;
1372   end;
1373 
1374 var
1375   Buf: string;
1376 
ReadInputPipenull1377   function ReadInputPipe(aStream: TInputPipeStream; var LineBuf: string): boolean;
1378   // true if some bytes have been read
1379   var
1380     Count: DWord;
1381     StartPos: Integer;
1382     i: DWord;
1383   begin
1384     Result:=false;
1385     if aStream=nil then exit;
1386     Count:=aStream.NumBytesAvailable;
1387     if Count=0 then exit;
1388     Count:=aStream.Read(Buf[1],Min(length(Buf),Count));
1389     if Count=0 then exit;
1390     Result:=true;
1391     StartPos:=1;
1392     i:=1;
1393     while i<=Count do begin
1394       if Buf[i] in [#10,#13] then begin
1395         LineBuf:=LineBuf+copy(Buf,StartPos,i-StartPos);
1396         fLines.Add(LineBuf);
1397         LineBuf:='';
1398         if (i<Count) and (Buf[i+1] in [#10,#13]) and (Buf[i]<>Buf[i+1])
1399         then
1400           inc(i);
1401         StartPos:=i+1;
1402       end;
1403       inc(i);
1404     end;
1405     LineBuf:=LineBuf+copy(Buf,StartPos,Count-StartPos+1);
1406   end;
1407 
1408 const
1409   UpdateTimeDiff = 1000 div 5; // update five times a second, even if there is still work
1410 var
1411   {$IFDEF VerboseExtToolThread}
1412   Title: String;
1413   {$ENDIF}
1414   OutputLine, StdErrLine: String;
1415   LastUpdate: QWord;
1416   ErrMsg: String;
1417   ok: Boolean;
1418   HasOutput: Boolean;
1419 begin
1420   {$IFDEF VerboseExtToolThread}
1421   Title:=Tool.Title;
1422   {$ENDIF}
1423   SetLength(Buf,4096);
1424   ErrorFrameCount:=0;
1425   fLines:=TStringList.Create;
1426   try
1427     try
1428       if Tool.Stage<>etsStarting then begin
1429         {$IFDEF VerboseExtToolThread}
1430         DebuglnThreadLog(['TExternalToolThread.Execute ',Title,' Tool.Stage=',dbgs(Tool.Stage),' aborting']);
1431         {$ENDIF}
1432         exit;
1433       end;
1434 
1435       {$IFDEF VerboseExtToolThread}
1436       DebuglnThreadLog(['TExternalToolThread.Execute ',Title,' check executing "',Tool.Process.Executable,'" ...']);
1437       {$ENDIF}
1438 
1439       if not FileIsExecutable(Tool.Process.Executable) then begin
1440         Tool.ErrorMessage:=Format(lisCanNotExecute, [Tool.Process.Executable]);
1441         Tool.ProcessStopped;
1442         exit;
1443       end;
1444       if not DirectoryExistsUTF8(ChompPathDelim(Tool.Process.CurrentDirectory))
1445       then begin
1446         Tool.ErrorMessage:=Format(lisMissingDirectory, [Tool.Process.
1447           CurrentDirectory]);
1448         Tool.ProcessStopped;
1449         exit;
1450       end;
1451 
1452       // Under Unix TProcess uses fpFork, which means the current thread is
1453       // duplicated. One is the old thread and one runs fpExecve.
1454       // If fpExecve runs, then it will not return.
1455       // If fpExecve fails it returns via an exception and this thread runs twice.
1456       ok:=false;
1457       try
1458         {$IFDEF VerboseExtToolThread}
1459         DebuglnThreadLog(['TExternalToolThread.Execute ',Title,' execute ...']);
1460         {$ENDIF}
1461         // now execute
1462         Tool.Process.PipeBufferSize:=Max(Tool.Process.PipeBufferSize,64*1024);
1463         Tool.Process.Execute;
1464         {$IFDEF VerboseExtToolThread}
1465         DebuglnThreadLog(['TExternalToolThread.Execute ',Title,' executing ...']);
1466         {$ENDIF}
1467         ok:=true;
1468       except
1469         on E: Exception do begin
1470           // BEWARE: we are now either in the normal thread or in the failed forked thread
1471           {$IFDEF VerboseExtToolThread}
1472           DebuglnThreadLog(['TExternalToolThread.Execute ',Title,' execute failed: ',E.Message]);
1473           {$ENDIF}
1474           if Tool.ErrorMessage='' then
1475             Tool.ErrorMessage:=Format(lisUnableToExecute, [E.Message]);
1476         end;
1477       end;
1478       // BEWARE: we are now either in the normal thread or in the failed forked thread
1479       if not ok then begin
1480         Tool.ProcessStopped;
1481         exit;
1482       end;
1483       // we are now in the normal thread
1484       if Tool.Stage>=etsStopped then
1485         exit;
1486       {$IFDEF VerboseExtToolThread}
1487       DebuglnThreadLog(['TExternalToolThread.Execute ',Title,' ProcessRunning ...']);
1488       {$ENDIF}
1489       Tool.ProcessRunning;
1490       if Tool.Stage>=etsStopped then
1491         exit;
1492       {$IFDEF VerboseExtToolThread}
1493       DebuglnThreadLog(['TExternalToolThread.Execute ',Title,' reading ...']);
1494       {$ENDIF}
1495 
1496       OutputLine:='';
1497       StdErrLine:='';
1498       LastUpdate:=GetTickCount64;
1499       while (Tool<>nil) and (Tool.Stage=etsRunning) do begin
1500         if Tool.ReadStdOutBeforeErr then begin
1501           HasOutput:=ReadInputPipe(Tool.Process.Output,OutputLine)
1502                   or ReadInputPipe(Tool.Process.Stderr,StdErrLine);
1503         end else begin
1504           HasOutput:=ReadInputPipe(Tool.Process.Stderr,StdErrLine)
1505                   or ReadInputPipe(Tool.Process.Output,OutputLine);
1506         end;
1507         if (not HasOutput) then begin
1508           // no more pending output
1509           if not Tool.Process.Running then break;
1510         end;
1511         if (fLines.Count>0)
1512         and (Abs(int64(GetTickCount64)-LastUpdate)>UpdateTimeDiff) then begin
1513           {$IFDEF VerboseExtToolThread}
1514           DebuglnThreadLog(['TExternalToolThread.Execute ',Title,' ',TimeToStr(Now),' ',IntToStr(GetTickCount64),' AddOutputLines ...']);
1515           {$ENDIF}
1516           Tool.AddOutputLines(fLines);
1517           {$IFDEF VerboseExtToolThread}
1518           DebuglnThreadLog(['TExternalToolThread.Execute ',Title,' AddOutputLines ok']);
1519           {$ENDIF}
1520           fLines.Clear;
1521           LastUpdate:=GetTickCount64;
1522         end;
1523         if (not HasOutput) then begin
1524           // no more pending output and process is still running
1525           // => tool needs some time
1526           Sleep(10);
1527         end;
1528       end;
1529       {$IFDEF VerboseExtToolThread}
1530       DebuglnThreadLog(['TExternalToolThread.Execute ',Title,' end reading']);
1531       {$ENDIF}
1532       // add rest of output
1533       if (OutputLine<>'') then
1534         fLines.Add(OutputLine);
1535       if (StdErrLine<>'') then
1536         fLines.Add(StdErrLine);
1537       if (Tool<>nil) and (fLines.Count>0) then begin
1538         {$IFDEF VerboseExtToolThread}
1539         DebuglnThreadLog(['TExternalToolThread.Execute ',Title,' final AddOutputLines ...']);
1540         {$ENDIF}
1541         Tool.AddOutputLines(fLines);
1542         {$IFDEF VerboseExtToolThread}
1543         DebuglnThreadLog(['TExternalToolThread.Execute ',Title,' final AddOutputLines ok']);
1544         {$ENDIF}
1545         fLines.Clear;
1546       end;
1547       try
1548         if Tool.Stage>=etsStopped then begin
1549           {$IFDEF VerboseExtToolThread}
1550           DebuglnThreadLog(['TExternalToolThread.Execute ',Title,' not reading exit status, because already stopped']);
1551           {$ENDIF}
1552           exit;
1553         end;
1554         {$IFDEF VerboseExtToolThread}
1555         DebuglnThreadLog(['TExternalToolThread.Execute ',Title,' reading exit status ...']);
1556         {$ENDIF}
1557         Tool.ExitStatus:=Tool.Process.ExitStatus;
1558         Tool.ExitCode:=Tool.Process.ExitCode;
1559         {$IFDEF VerboseExtToolThread}
1560         if Tool.ExitStatus<>0 then
1561           DebuglnThreadLog(['TExternalToolThread.Execute ',Title,' exit status=',Tool.ExitStatus,' ExitCode=',Tool.ExitCode]);
1562         {$ENDIF}
1563       except
1564         Tool.ErrorMessage:=lisUnableToReadProcessExitStatus;
1565       end;
1566     except
1567       on E: Exception do begin
1568         {$IFDEF VerboseExtToolThread}
1569         DebuglnThreadLog(['TExternalToolThread.Execute ',Title,' run: ',E.Message]);
1570         {$ENDIF}
1571         if (Tool<>nil) and (Tool.ErrorMessage='') then begin
1572           Tool.ErrorMessage:=E.Message;
1573           ErrMsg:=GetExceptionStackTrace;
1574           {$IFDEF VerboseExtToolErrors}
1575           DebuglnThreadLog(ErrMsg);
1576           {$ENDIF}
1577           Tool.ErrorMessage:=E.Message+LineEnding+ErrMsg;
1578         end;
1579       end;
1580     end;
1581   finally
1582     {$IFDEF VerboseExtToolThread}
1583     if fLines<>nil then
1584       DebuglnThreadLog(['TExternalToolThread.Execute ',Title,' cleaning up']);
1585     {$ENDIF}
1586     // clean up
1587     try
1588       FreeAndNil(fLines);
1589     except
1590       on E: Exception do begin
1591         {$IFDEF VerboseExtToolThread}
1592         DebuglnThreadLog(['TExternalToolThread.Execute adding pending messages: ',E.Message]);
1593         {$ENDIF}
1594         if Tool<>nil then
1595           Tool.ErrorMessage:=Format(lisFreeingBufferLines, [E.Message]);
1596       end;
1597     end;
1598   end;
1599   if Tool.Stage>=etsStopped then begin
1600     {$IFDEF VerboseExtToolThread}
1601     DebuglnThreadLog(['TExternalToolThread.Execute ',Title,' not cleaning up']);
1602     {$ENDIF}
1603     exit;
1604   end;
1605   {$IFDEF VerboseExtToolThread}
1606   DebuglnThreadLog(['TExternalToolThread.Execute ',Title,' ProcessStopped ...']);
1607   {$ENDIF}
1608   if Tool<>nil then
1609     Tool.ProcessStopped;
1610   {$IFDEF VerboseExtToolThread}
1611   DebuglnThreadLog(['TExternalToolThread.Execute ',Title,' Thread END']);
1612   {$ENDIF}
1613 end;
1614 
1615 procedure TExternalToolThread.DebuglnThreadLog(const Args: array of const);
1616 begin
1617   debugln(Args);
1618 end;
1619 
1620 destructor TExternalToolThread.Destroy;
1621 begin
1622   Tool:=nil;
1623   inherited Destroy;
1624 end;
1625 
1626 end.
1627 
1628