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 // BuildIntf
43 IDEExternToolIntf, BaseIDEIntf, MacroIntf, LazMsgWorker,
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; // (main thread)
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; // (main thread)
113 procedure Terminate; override; // (main thread)
114 procedure WaitForExit; override; // (main thread)
ResolveMacrosnull115 function ResolveMacros: boolean; override; // (main thread)
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 fOldThreads: TFPList; // list of TExternalToolThread, needs Enter/LeaveCriticalSection
135 FMaxProcessCount: integer;
136 fParsers: TFPList; // list of TExtToolParserClass
137 procedure AddOldThread(aThread: TExternalToolThread); // (main thread)
GetRunningToolsnull138 function GetRunningTools(Index: integer): TExternalTool;
139 procedure AddRunningTool(Tool: TExternalTool); // (worker thread)
140 procedure RemoveRunningTool(Tool: TExternalTool); // (worker thread)
RunExtToolHandlernull141 function RunExtToolHandler(ToolOptions: TIDEExternalToolOptions): boolean; // (main thread)
RunToolAndDetachnull142 function RunToolAndDetach(ToolOptions: TIDEExternalToolOptions): boolean; // (main thread)
RunToolWithParsersnull143 function RunToolWithParsers(ToolOptions: TIDEExternalToolOptions): boolean; // (main thread)
144 procedure FreeFinishedThreads; // (main thread)
145 procedure OnThreadTerminate(Sender: TObject); // (main thread)
146 protected
147 FToolClass: TExternalToolClass;
GetParsersnull148 function GetParsers(Index: integer): TExtToolParserClass; override;
149 procedure Notification(AComponent: TComponent; Operation: TOperation); override;
150 public
151 constructor Create(aOwner: TComponent); override;
152 destructor Destroy; override;
Addnull153 function Add(Title: string): TAbstractExternalTool; override;
IndexOfnull154 function IndexOf(Tool: TAbstractExternalTool): integer; override;
155 property MaxProcessCount: integer read FMaxProcessCount write FMaxProcessCount;
156 procedure Work;
FindNextToolToStartnull157 function FindNextToolToStart: TExternalTool;
158 procedure Terminate(Tool: TExternalTool);
159 procedure TerminateAll; override;
160 procedure Clear; override;
RunningCountnull161 function RunningCount: integer;
162 property RunningTools[Index: integer]: TExternalTool read GetRunningTools;
163 procedure EnterCriticalSection; override;
164 procedure LeaveCriticalSection; override;
165 // parsers
ParserCountnull166 function ParserCount: integer; override;
167 procedure RegisterParser(Parser: TExtToolParserClass); override;
168 procedure UnregisterParser(Parser: TExtToolParserClass); override;
FindParserForToolnull169 function FindParserForTool(const SubTool: string): TExtToolParserClass; override;
FindParserWithNamenull170 function FindParserWithName(const ParserName: string): TExtToolParserClass; override;
GetMsgToolnull171 function GetMsgTool(Msg: TMessageLine): TAbstractExternalTool; override;
172 end;
173
174 TExternalToolsClass = class of TExternalTools;
175
ExternalToolsRefnull176 function ExternalToolsRef: TExternalTools;
177
178
179 implementation
180
ExternalToolsRefnull181 function ExternalToolsRef: TExternalTools;
182 begin
183 Result := ExternalToolList as TExternalTools;
184 end;
185
186 {$IF defined(VerboseExtToolErrors) or defined(VerboseExtToolThread) or defined(VerboseExtToolAddOutputLines)}
ArgsToStringnull187 function ArgsToString(Args: array of const): string;
188 var
189 i: Integer;
190 begin
191 Result := '';
192 for i:=Low(Args) to High(Args) do begin
193 case Args[i].VType of
194 vtInteger: Result := Result + dbgs(Args[i].vinteger);
195 vtInt64: Result := Result + dbgs(Args[i].VInt64^);
196 vtQWord: Result := Result + dbgs(Args[i].VQWord^);
197 vtBoolean: Result := Result + dbgs(Args[i].vboolean);
198 vtExtended: Result := Result + dbgs(Args[i].VExtended^);
199 vtString: Result := Result + Args[i].VString^;
200 vtAnsiString: Result := Result + AnsiString(Args[i].VAnsiString);
201 vtChar: Result := Result + Args[i].VChar;
202 vtPChar: Result := Result + Args[i].VPChar;
203 vtPWideChar: Result := {%H-}Result {%H-}+ Args[i].VPWideChar;
204 vtWideChar: Result := Result + AnsiString(Args[i].VWideChar);
205 vtWidestring: Result := Result + AnsiString(WideString(Args[i].VWideString));
206 vtObject: Result := Result + DbgSName(Args[i].VObject);
207 vtClass: Result := Result + DbgSName(Args[i].VClass);
208 vtPointer: Result := Result + Dbgs(Args[i].VPointer);
209 else Result := Result + '?unknown variant?';
210 end;
211 end;
212 end;
213
214 procedure DebuglnThreadLog(const args: array of const);
215 var
216 s, Filename: string;
217 fs: TFileStream;
218 begin
219 if GetCurrentThreadId=MainThreadID then
220 debugln(args)
221 else
222 begin
223 s:=ArgsToString(args)+sLineBreak;
224 Filename:='lazdbg'+IntToStr(GetCurrentThreadId)+'.log';
225 if FileExistsUTF8(Filename) then
226 fs:=TFileStream.Create(Filename,fmOpenWrite or fmShareDenyNone)
227 else
228 fs:=TFileStream.Create(Filename,fmCreate);
229 try
230 try
231 fs.Seek(0,soEnd);
232 fs.Write(s[1],length(s));
233 except
234 end;
235 finally
236 fs.Free;
237 end;
238 end;
239 end;
240 {$ENDIF}
241
242 { TLazExtToolView }
243
244 procedure TLazExtToolView.SetToolState(AValue: TLMVToolState);
245 begin
246 if FToolState=AValue then Exit;
247 FToolState:=AValue;
248 end;
249
250 { TExternalTool }
251
252 procedure TExternalTool.ProcessRunning;
253 var
254 i: Integer;
255 begin
256 EnterCriticalSection;
257 try
258 if FStage<>etsStarting then exit;
259 FStage:=etsRunning;
260 finally
261 LeaveCriticalSection;
262 end;
263 for i:=0 to ParserCount-1 do
264 Parsers[i].InitReading;
265 end;
266
267 procedure TExternalTool.ProcessStopped;
268 var
269 i: Integer;
270 begin
271 {$IFDEF VerboseExtToolErrors}
272 if ErrorMessage<>'' then
273 DebuglnThreadLog(['TExternalTool.ThreadStopped ',Title,' ErrorMessage=',ErrorMessage]);
274 {$ENDIF}
275 if Thread<>nil then
276 Thread.Tool:=nil;
277 EnterCriticalSection;
278 try
279 if (not Terminated) and (ErrorMessage='') then
280 begin
281 if ExitCode<>0 then
282 ErrorMessage:=Format(lisExitCode, [IntToStr(ExitCode)])
283 else if ExitStatus<>0 then
284 ErrorMessage:='ExitStatus '+IntToStr(ExitStatus);
285 end;
286 if FStage>=etsStopped then exit;
287 FStage:=etsStopped;
288 finally
289 LeaveCriticalSection;
290 end;
291 for i:=0 to ParserCount-1 do begin
292 try
293 Parsers[i].Done;
294 except
295 on E: Exception do begin
296 {$IFDEF VerboseExtToolErrors}
297 DebuglnThreadLog(['TExternalTool.ProcessStopped ',Title,' Error in ',DbgSName(Parsers[i]),': ',E.Message]);
298 {$ENDIF}
299 end;
300 end;
301 end;
302 if Tools<>nil then
303 TExternalTools(Tools).RemoveRunningTool(Self);
304 TThread.Synchronize(nil,@NotifyHandlerStopped);
305 end;
306
307 procedure TExternalTool.AddOutputLines(Lines: TStringList);
308 var
309 i: Integer;
310 Handled: Boolean;
311 Line: LongInt;
312 OldOutputCount: LongInt;
313 OldMsgCount: LongInt;
314 Parser: TExtToolParser;
315 NeedSynchronize, IsStdErr: Boolean;
316 MsgLine: TMessageLine;
317 LineStr: String;
318 begin
319 {$IFDEF VerboseExtToolAddOutputLines}
320 DebuglnThreadLog(['TExternalTool.AddOutputLines ',Title,' Tick=',IntToStr(GetTickCount64),' Lines=',Lines.Count]);
321 {$ENDIF}
322 if (Lines=nil) or (Lines.Count=0) then exit;
323 NeedSynchronize:=false;
324 EnterCriticalSection;
325 try
326 OldOutputCount:=WorkerOutput.Count;
327 OldMsgCount:=WorkerMessages.Count;
328 WorkerOutput.AddStrings(Lines);
329 for i:=0 to ParserCount-1 do
330 Parsers[i].NeedSynchronize:=false;
331
332 // feed new lines into all parsers, converting raw lines into messages
333 for Line:=OldOutputCount to WorkerOutput.Count-1 do begin
334 Handled:=false;
335 LineStr:=WorkerOutput[Line];
336 IsStdErr:=WorkerOutput.Objects[Line]<>nil;
337 for i:=0 to ParserCount-1 do begin
338 {$IFDEF VerboseExtToolAddOutputLines}
339 DebuglnThreadLog(['TExternalTool.AddOutputLines ',DbgSName(Parsers[i]),' Line="',WorkerOutput[Line],'" READLINE ...']);
340 {$ENDIF}
341 Parsers[i].ReadLine(LineStr,Line,IsStdErr,Handled);
342 if Handled then break;
343 end;
344 if (not Handled) then begin
345 MsgLine:=WorkerMessages.CreateLine(Line);
346 MsgLine.Msg:=LineStr; // use raw output as default msg
347 MsgLine.Urgency:=mluDebug;
348 if IsStdErr then
349 MsgLine.Flags:=MsgLine.Flags+[mlfStdErr];
350 WorkerMessages.Add(MsgLine);
351 end;
352 end;
353
354 // let all parsers improve the new messages
355 if OldMsgCount<WorkerMessages.Count then begin
356 for i:=0 to ParserCount-1 do begin
357 Parser:=Parsers[i];
358 Parser.NeedSynchronize:=false;
359 Parser.NeedAfterSync:=false;
360 {$IFDEF VerboseExtToolAddOutputLines}
361 DebuglnThreadLog(['TExternalTool.AddOutputLines ',DbgSName(Parser),' IMPROVE after ReadLine ...']);
362 {$ENDIF}
363 Parser.ImproveMessages(etpspAfterReadLine);
364 if Parser.NeedSynchronize then
365 NeedSynchronize:=true;
366 end;
367 end;
368 finally
369 LeaveCriticalSection;
370 end;
371
372 // let all parsers improve the new messages
373 if NeedSynchronize then begin
374 {$IFDEF VerboseExtToolAddOutputLines}
375 DebuglnThreadLog(['TExternalTool.AddOutputLines SynchronizedImproveMessages ...']);
376 {$ENDIF}
377 Thread.Synchronize(Thread,@SynchronizedImproveMessages);
378 end;
379
380 EnterCriticalSection;
381 try
382 if fNeedAfterSync then begin
383 for i:=0 to ParserCount-1 do begin
384 Parser:=Parsers[i];
385 if not Parser.NeedAfterSync then continue;
386 {$IFDEF VerboseExtToolAddOutputLines}
387 DebuglnThreadLog(['TExternalTool.AddOutputLines ',DbgSName(Parser),' IMPROVE after sync ...']);
388 {$ENDIF}
389 Parser.ImproveMessages(etpspAfterSync);
390 end;
391 end;
392
393 // feed new messages into all viewers
394 if OldMsgCount<WorkerMessages.Count then begin
395 for i:=0 to ViewCount-1 do begin
396 {$IFDEF VerboseExtToolAddOutputLines}
397 DebuglnThreadLog(['TExternalTool.AddOutputLines ',DbgSName(Views[i]),' "',Views[i].Caption,'" ProcessNewMessages ...']);
398 {$ENDIF}
399 Views[i].ProcessNewMessages(Thread);
400 end;
401 end;
402 finally
403 LeaveCriticalSection;
404 end;
405
406 // notify main thread handlers for new output
407 // Note: The IDE itself does not set such a handler
408 if {$IFDEF VerboseExtToolAddOutputLines}true{$ELSE}FHandlers[ethNewOutput].Count>0{$ENDIF}
409 then begin
410 {$IFDEF VerboseExtToolAddOutputLines}
411 DebuglnThreadLog(['TExternalTool.AddOutputLines NotifyHandlerNewOutput ...']);
412 {$ENDIF}
413 Thread.Synchronize(Thread,@NotifyHandlerNewOutput);
414 end;
415 fOutputCountNotified:=WorkerOutput.Count;
416 {$IFDEF VerboseExtToolAddOutputLines}
417 DebuglnThreadLog(['TExternalTool.AddOutputLines END']);
418 {$ENDIF}
419 end;
420
421 procedure TExternalTool.NotifyHandlerStopped;
422 var
423 i: Integer;
424 View: TExtToolView;
425 begin
426 DoCallNotifyHandler(ethStopped);
427
428 EnterCriticalSection;
429 try
430 for i:=ViewCount-1 downto 0 do begin
431 if i>=ViewCount then continue;
432 View:=Views[i];
433 if ErrorMessage<>'' then
434 View.SummaryMsg:=ErrorMessage
435 else
436 View.SummaryMsg:=lisSuccess;
437 View.InputClosed; // this might delete the view
438 end;
439 finally
440 LeaveCriticalSection;
441 end;
442
443 if Group<>nil then
444 Group.ToolExited(Self);
445
446 // process stopped => start next
447 if Tools<>nil then
448 TExternalTools(Tools).Work;
449
450 // free tool if not used
451 AutoFree;
452 end;
453
454 procedure TExternalTool.NotifyHandlerNewOutput;
455 var
456 i: integer;
457 begin
458 if fOutputCountNotified>=WorkerOutput.Count then exit;
459 {$IFDEF VerboseExtToolAddOutputLines}
460 for i:=fOutputCountNotified to WorkerOutput.Count-1 do
461 debugln('IDE-DEBUG: ',WorkerOutput[i]);
462 {$ENDIF}
463 i:=FHandlers[ethNewOutput].Count;
464 while FHandlers[ethNewOutput].NextDownIndex(i) do
465 TExternalToolNewOutputEvent(FHandlers[ethNewOutput][i])(Self,fOutputCountNotified);
466 end;
467
468 procedure TExternalTool.SetThread(AValue: TExternalToolThread);
469 var
470 OldThread: TExternalToolThread;
471 begin
472 if FThread=AValue then Exit;
473 OldThread:=FThread;
474 FThread:=AValue;
475 if OldThread<>nil then
476 OldThread.Tool:=nil;
477 if FThread<>nil then
478 FThread.Tool:=Self;
479 end;
480
481 procedure TExternalTool.SynchronizedImproveMessages;
482 var
483 i: Integer;
484 Parser: TExtToolParser;
485 begin
486 EnterCriticalSection;
487 try
488 fNeedAfterSync:=false;
489 for i:=0 to ParserCount-1 do begin
490 Parser:=Parsers[i];
491 if not Parser.NeedSynchronize then continue;
492 {$IFDEF VerboseExtToolAddOutputLines}
493 //debugln(['TExternalTool.SynchronizedImproveMessages ',DbgSName(Parser),' ...']);
494 {$ENDIF}
495 Parser.ImproveMessages(etpspSynchronized);
496 Parser.NeedSynchronize:=false;
497 if Parser.NeedAfterSync then
498 fNeedAfterSync:=true;
499 end;
500 finally
501 LeaveCriticalSection;
502 end;
503 end;
504
505 constructor TExternalTool.Create(aOwner: TComponent);
506 begin
507 inherited Create(aOwner);
508 FWorkerOutput:=TStringList.Create;
509 FProcess:=TProcessUTF8.Create(nil);
510 FProcess.Options:= [poUsePipes{$IFDEF Windows},poStderrToOutPut{$ENDIF}];
511 FProcess.ShowWindow := swoHide;
512 fExecuteBefore:=TFPList.Create;
513 fExecuteAfter:=TFPList.Create;
514 end;
515
516 destructor TExternalTool.Destroy;
517 var
518 OldThread: TExternalToolThread;
519 begin
520 //debugln(['TExternalTool.Destroy ',Title]);
521 EnterCriticalSection;
522 try
523 FStage:=etsDestroying;
524 if Thread is TExternalToolThread then
525 begin
526 OldThread:=TExternalToolThread(Thread);
527 fThread:=nil;
528 OldThread.Tool:=nil;
529 end;
530 FreeAndNil(FProcess);
531 FreeAndNil(FWorkerOutput);
532 FreeAndNil(fExecuteBefore);
533 FreeAndNil(fExecuteAfter);
534 finally
535 LeaveCriticalSection;
536 end;
537 inherited Destroy;
538 end;
539
540 procedure TExternalTool.DoExecute;
541 // in main thread
542
CheckErrornull543 function CheckError: boolean;
544 begin
545 if (FStage>=etsStopped) then exit(true);
546 if (ErrorMessage='') then exit(false);
547 debugln(['Error: (lazarus) [TExternalTool.DoExecute.CheckError] Error=',ErrorMessage]);
548 EnterCriticalSection;
549 try
550 if FStage>=etsStopped then exit(true);
551 FStage:=etsStopped;
552 finally
553 LeaveCriticalSection;
554 end;
555 CreateView;
556 NotifyHandlerStopped;
557
558 Result:=true;
559 end;
560
561 var
562 ExeFile: String;
563 i: Integer;
564 aParser: TExtToolParser;
565 begin
566 if Terminated then exit;
567
568 // set Stage to etsInitializing
569 EnterCriticalSection;
570 try
571 if Stage<>etsInit then
572 raise Exception.Create('TExternalTool.Execute: already initialized');
573 FStage:=etsInitializing;
574 finally
575 LeaveCriticalSection;
576 end;
577
578 // resolve macros
579 if ResolveMacrosOnExecute then
580 begin
581 if not ResolveMacros then begin
582 if ErrorMessage='' then
583 ErrorMessage:=lisFailedToResolveMacros;
584 if CheckError then exit;
585 end;
586 end;
587
588 // init CurrentDirectory
589 Process.CurrentDirectory:=TrimFilename(Process.CurrentDirectory);
590 if not FilenameIsAbsolute(Process.CurrentDirectory) then
591 Process.CurrentDirectory:=AppendPathDelim(GetCurrentDirUTF8)+Process.CurrentDirectory;
592
593 // init Executable
594 Process.Executable:=TrimFilename(Process.Executable);
595 {$IFDEF VerboseExtToolThread}
596 debugln(['TExternalTool.DoExecute Exe=',Process.Executable]);
597 {$ENDIF}
598 if not FilenameIsAbsolute(Process.Executable) then begin
599 if ExtractFilePath(Process.Executable)<>'' then
600 Process.Executable:=AppendPathDelim(GetCurrentDirUTF8)+Process.Executable
601 else if Process.Executable='' then begin
602 ErrorMessage:=Format(lisToolHasNoExecutable, [Title]);
603 CheckError;
604 exit;
605 end else begin
606 ExeFile:=FindDefaultExecutablePath(Process.Executable,GetCurrentDirUTF8);
607 if ExeFile='' then begin
608 ErrorMessage:=Format(lisCanNotFindExecutable, [Process.Executable]);
609 CheckError;
610 exit;
611 end;
612 Process.Executable:=ExeFile;
613 end;
614 end;
615 ExeFile:=Process.Executable;
616 if not FileExistsUTF8(ExeFile) then begin
617 ErrorMessage:=Format(lisMissingExecutable, [ExeFile]);
618 CheckError;
619 exit;
620 end;
621 if DirectoryExistsUTF8(ExeFile) then begin
622 ErrorMessage:=Format(lisExecutableIsADirectory, [ExeFile]);
623 CheckError;
624 exit;
625 end;
626 if not FileIsExecutable(ExeFile) then begin
627 ErrorMessage:=Format(lisExecutableLacksThePermissionToRun, [ExeFile]);
628 CheckError;
629 exit;
630 end;
631
632 // init misc
633 WorkerMessages.BaseDirectory:=Process.CurrentDirectory;
634 WorkerDirectory:=WorkerMessages.BaseDirectory;
635 if EnvironmentOverrides.Count>0 then
636 AssignEnvironmentTo(Process.Environment,EnvironmentOverrides);
637
638 // init parsers
639 for i:=0 to ParserCount-1 do begin
640 aParser:=Parsers[i];
641 try
642 aParser.Init;
643 except
644 on E: Exception do begin
645 ErrorMessage:=Format(lisParser, [DbgSName(aParser), E.Message]);
646 CheckError;
647 exit;
648 end;
649 end;
650 end;
651
652 // set Stage to etsWaitingForStart
653 EnterCriticalSection;
654 try
655 if Stage<>etsInitializing then
656 raise Exception.Create('TExternalTool.Execute: bug in initialization');
657 FStage:=etsWaitingForStart;
658 finally
659 LeaveCriticalSection;
660 end;
661 end;
662
663 procedure TExternalTool.DoStart;
664 var
665 i: Integer;
666 begin
667 // set Stage to etsStarting
668 EnterCriticalSection;
669 try
670 if Stage<>etsWaitingForStart then
671 raise Exception.Create('TExternalTool.Execute: already started');
672 FStage:=etsStarting;
673 finally
674 LeaveCriticalSection;
675 end;
676
677 CreateView;
678
679 // mark running
680 if Tools<>nil then
681 TExternalTools(Tools).AddRunningTool(Self);
682
683 // start thread
684 if Thread=nil then begin
685 FThread:=TExternalToolThread.Create(true);
686 Thread.Tool:=Self;
687 FThread.FreeOnTerminate:=false;
688 FThread.OnTerminate:=@TExternalTools(Tools).OnThreadTerminate;
689 end;
690 if ConsoleVerbosity>=0 then begin
691 debugln(['Info: (lazarus) Execute Title="',Title,'"']);
692 debugln(['Info: (lazarus) Working Directory="',Process.CurrentDirectory,'"']);
693 debugln(['Info: (lazarus) Executable="',Process.Executable,'"']);
694 for i:=0 to Process.Parameters.Count-1 do
695 debugln(['Info: (lazarus) Param[',i,']="',Process.Parameters[i],'"']);
696 for i:=0 to Process.Environment.Count-1 do
697 debugln(['Info: (lazarus) Env[',i,']="',LeftStr(DbgStr(Process.Environment[i]),100),'"']);
698 end;
699 Thread.Start;
700 end;
701
ExecuteBeforeCountnull702 function TExternalTool.ExecuteBeforeCount: integer;
703 begin
704 Result:=fExecuteBefore.Count;
705 end;
706
TExternalTool.ExecuteAfterCountnull707 function TExternalTool.ExecuteAfterCount: integer;
708 begin
709 Result:=fExecuteAfter.Count;
710 end;
711
GetExecuteAfternull712 function TExternalTool.GetExecuteAfter(Index: integer): TAbstractExternalTool;
713 begin
714 Result:=TAbstractExternalTool(fExecuteAfter[Index]);
715 end;
716
GetExecuteBeforenull717 function TExternalTool.GetExecuteBefore(Index: integer): TAbstractExternalTool;
718 begin
719 Result:=TAbstractExternalTool(fExecuteBefore[Index]);
720 end;
721
722 procedure TExternalTool.DoTerminate;
723 var
724 NeedProcTerminate: Boolean;
725 begin
726 NeedProcTerminate:=false;
727 EnterCriticalSection;
728 try
729 if ConsoleVerbosity>0 then
730 DebugLn(['Info: (lazarus) TExternalTool.DoTerminate ',Title,', Terminated=',Terminated,', Stage=',dbgs(Stage)]);
731 if Terminated then exit;
732 if Stage=etsStopped then exit;
733
734 if ErrorMessage='' then
735 ErrorMessage:=lisAborted;
736 fTerminated:=true;
737 if Stage=etsRunning then
738 NeedProcTerminate:=true;
739 if Stage<etsStarting then
740 FStage:=etsStopped
741 else if Stage<=etsRunning then
742 FStage:=etsWaitingForStop;
743 finally
744 LeaveCriticalSection;
745 end;
746 if NeedProcTerminate and (Process<>nil) then begin
747 if ConsoleVerbosity>0 then
748 DebugLn(['Info: (lazarus) TExternalTool.DoTerminate ',Title,'. Terminating the process.']);
749 Process.Terminate(AbortedExitCode);
750 end;
751 end;
752
753 procedure TExternalTool.Notification(AComponent: TComponent; Operation: TOperation);
754 begin
755 inherited Notification(AComponent, Operation);
756 if Operation=opRemove then begin
757 if fExecuteBefore<>nil then
758 fExecuteBefore.Remove(AComponent);
759 if fExecuteAfter<>nil then
760 fExecuteAfter.Remove(AComponent);
761 end;
762 end;
763
TExternalTool.CanFreenull764 function TExternalTool.CanFree: boolean;
765 begin
766 Result:=(FThread=nil) and inherited CanFree;
767 end;
768
IsExecutedBeforenull769 function TExternalTool.IsExecutedBefore(Tool: TAbstractExternalTool): Boolean;
770 var
771 Visited: TFPList;
772
Searchnull773 function Search(CurTool: TAbstractExternalTool): Boolean;
774 var
775 i: Integer;
776 begin
777 if CurTool=Tool then exit(true);
778 if Visited.IndexOf(CurTool)>=0 then exit(false);
779 Visited.Add(CurTool);
780 for i:=0 to CurTool.ExecuteBeforeCount-1 do
781 if Search(CurTool.ExecuteBefore[i]) then exit(true);
782 Result:=false;
783 end;
784
785 begin
786 Result:=false;
787 if Tool=Self then exit;
788 Visited:=TFPList.Create;
789 try
790 Result:=Search(Self);
791 finally
792 Visited.Free;
793 end;
794 end;
795
796 procedure TExternalTool.AddExecuteBefore(Tool: TAbstractExternalTool);
797 begin
798 //debugln(['TExternalTool.AddExecuteBefore Self=',Title,' Tool=',Tool.Title]);
799 if (Tool=Self) or (Tool.IsExecutedBefore(Self)) then
800 raise Exception.Create('TExternalTool.AddExecuteBefore: that would create a circle');
801 if (fExecuteBefore<>nil) and (fExecuteBefore.IndexOf(Tool)<0) then
802 fExecuteBefore.Add(Tool);
803 if (TExternalTool(Tool).fExecuteAfter<>nil)
804 and (TExternalTool(Tool).fExecuteAfter.IndexOf(Self)<=0) then
805 TExternalTool(Tool).fExecuteAfter.Add(Self);
806 end;
807
TExternalTool.CanStartnull808 function TExternalTool.CanStart: boolean;
809 var
810 i: Integer;
811 ExecBefore: TAbstractExternalTool;
812 begin
813 Result:=false;
814 //debugln(['TExternalTool.CanStart ',Title,' ',dbgs(Stage)]);
815 if Stage<>etsWaitingForStart then exit;
816 if Terminated then exit;
817 for i:=0 to ExecuteBeforeCount-1 do begin
818 ExecBefore:=ExecuteBefore[i];
819 if ord(ExecBefore.Stage)<ord(etsStopped) then exit;
820 if ExecBefore.ErrorMessage<>'' then exit;
821 end;
822 Result:=true;
823 end;
824
TExternalTool.GetLongestEstimatedLoadnull825 function TExternalTool.GetLongestEstimatedLoad: int64;
826 type
827 TInfo = record
828 Load: int64;
829 end;
830 PInfo = ^TInfo;
831 var
832 ToolToInfo: TPointerToPointerTree;
833
GetLoadnull834 function GetLoad(Tool: TExternalTool): int64;
835 var
836 Info: PInfo;
837 i: Integer;
838 begin
839 Info:=PInfo(ToolToInfo[Tool]);
840 if Info<>nil then
841 Result:=Info^.Load
842 else begin
843 New(Info);
844 Info^.Load:=1;
845 ToolToInfo[Tool]:=Info;
846 Result:=0;
847 for i:=0 to Tool.ExecuteAfterCount-1 do
848 Result:=Max(Result,GetLoad(TExternalTool(Tool.ExecuteAfter[i])));
849 inc(Result,Tool.EstimatedLoad);
850 Info^.Load:=Result;
851 end;
852 end;
853
854 var
855 Node: TAvlTreeNode;
856 Item: PPointerToPointerItem;
857 Info: PInfo;
858 begin
859 ToolToInfo:=TPointerToPointerTree.Create;
860 try
861 Result:=GetLoad(Self);
862 finally
863 Node:=ToolToInfo.Tree.FindLowest;
864 while Node<>nil do begin
865 Item:=PPointerToPointerItem(Node.Data);
866 Info:=PInfo(Item^.Value);
867 Dispose(Info);
868 Node:=ToolToInfo.Tree.FindSuccessor(Node);
869 end;
870 ToolToInfo.Free;
871 end;
872 end;
873
874 procedure TExternalTool.Execute;
875 begin
876 if Stage<>etsInit then
877 raise Exception.Create('TExternalTool.Execute "'+Title+'" already started');
878 DoExecute;
879 if Stage<>etsWaitingForStart then
880 exit;
881
882 if Tools<>nil then
883 TExternalTools(Tools).Work
884 else
885 DoStart;
886 end;
887
888 procedure TExternalTool.Terminate;
889 begin
890 if Tools<>nil then
891 TExternalTools(Tools).Terminate(Self)
892 else
893 DoTerminate;
894 end;
895
896 procedure TExternalTool.WaitForExit;
897 var
898 MyTools: TExternalToolsBase;
899 begin
900 MyTools:=Tools;
901 repeat
902 EnterCriticalSection;
903 try
904 if Stage=etsDestroying then exit;
905 if (Stage=etsStopped) and (FindUnfinishedView=nil) then exit;
906 finally
907 LeaveCriticalSection;
908 end;
909 // call synchronized tasks, this might free this tool
910 if MainThreadID=ThreadID then
911 begin
912 Assert(Owner is TExternalToolsBase, 'TExternalTool.WaitForExit: Owner is not TExternalToolsBase.');
913 TExternalToolsBase(Owner).HandleMessages;
914 end;
915 Assert(Assigned(ExternalToolList), 'TExternalTool.WaitForExit: ExternalToolList=Nil.');
916 // check if this tool still exists
917 if MyTools.IndexOf(Self)<0 then exit;
918 // still running => wait
919 Sleep(50);
920 until false;
921 end;
922
TExternalTool.ResolveMacrosnull923 function TExternalTool.ResolveMacros: boolean;
924
Resolvenull925 function Resolve(const aValue: string; out NewValue: string): boolean;
926 begin
927 NewValue:=aValue;
928 Result:=IDEMacros.SubstituteMacros(NewValue);
929 if Result then exit;
930 if ErrorMessage='' then
931 ErrorMessage:=Format(lisInvalidMacrosIn, [aValue]);
932 LazMessageWorker(lisCCOErrorCaption, Format(lisInvalidMacrosInExternalTool,
933 [aValue, Title]),
934 mtError,[mbCancel]);
935 end;
936
937 var
938 i: Integer;
939 s: string;
940 begin
941 if IDEMacros=nil then exit(true);
942 Result:=false;
943
944 if not Resolve(Process.CurrentDirectory,s) then exit;
945 Process.CurrentDirectory:=s;
946
947 if not Resolve(Process.Executable,s) then exit;
948 Process.Executable:=s;
949
950 for i:=0 to Process.Parameters.Count-1 do begin
951 if not Resolve(Process.Parameters[i],s) then exit;
952 Process.Parameters[i]:=s;
953 end;
954
955 for i:=0 to EnvironmentOverrides.Count-1 do begin
956 if not Resolve(EnvironmentOverrides[i],s) then exit;
957 EnvironmentOverrides[i]:=s;
958 end;
959
960 Result:=true;
961 end;
962
963 procedure TExternalTool.RemoveExecuteBefore(Tool: TAbstractExternalTool);
964 begin
965 if fExecuteBefore<>nil then
966 fExecuteBefore.Remove(Tool);
967 if TExternalTool(Tool).fExecuteAfter<>nil then
968 TExternalTool(Tool).fExecuteAfter.Remove(Self);
969 end;
970
971 { TExternalTools }
972
RunExtToolHandlernull973 function TExternalTools.RunExtToolHandler(ToolOptions: TIDEExternalToolOptions): boolean;
974 begin
975 {$IFDEF VerboseExtToolThread}
976 debugln(['TExternalTools.RunExtToolHandler ',ToolOptions.Title,
977 ' exe="',ToolOptions.Executable,'" params="',ToolOptions.CmdLineParams,'"']);
978 {$ENDIF}
979 if ToolOptions.Parsers.Count=0 then
980 Result := RunToolAndDetach(ToolOptions)
981 else
982 Result := RunToolWithParsers(ToolOptions)
983 end;
984
RunToolAndDetachnull985 function TExternalTools.RunToolAndDetach(ToolOptions: TIDEExternalToolOptions): boolean;
986 // simply run and detach
987 var
988 i: Integer;
989 Proc: TProcessUTF8;
990 sl: TStringList;
991 s, Path: String;
992 begin
993 Result:=false;
994 Proc:=TProcessUTF8.Create(nil);
995 try
996 Proc.InheritHandles:=false;
997 // working directory
998 s:=ToolOptions.WorkingDirectory;
999 if ToolOptions.ResolveMacros then begin
1000 if not GlobalMacroList.SubstituteStr(s) then begin
1001 debugln(['Error: (lazarus) [TExternalTools.RunToolAndDetach] ',ToolOptions.Title,' failed: macros of WorkerDirectory: "',ToolOptions.WorkingDirectory,'"']);
1002 exit;
1003 end;
1004 end;
1005 s:=ChompPathDelim(CleanAndExpandDirectory(s));
1006 if not DirectoryExistsUTF8(s) then begin
1007 debugln(['Error: (lazarus) [TExternalTools.RunToolAndDetach] ',ToolOptions.Title,' failed: missing directory "',s,'"']);
1008 exit;
1009 end;
1010 Proc.CurrentDirectory:=s;
1011
1012 // environment
1013 if ToolOptions.EnvironmentOverrides.Count>0 then
1014 AssignEnvironmentTo(Proc.Environment,ToolOptions.EnvironmentOverrides);
1015 if ToolOptions.ResolveMacros then begin
1016 for i:=0 to Proc.Environment.Count-1 do begin
1017 s:=Proc.Environment[i];
1018 if not GlobalMacroList.SubstituteStr(s) then begin
1019 debugln(['Error: (lazarus) [TExternalTools.RunToolAndDetach] ',ToolOptions.Title,' failed: environment override "',Proc.Environment,'"']);
1020 exit;
1021 end;
1022 Proc.Environment[i]:=s;
1023 end;
1024 end;
1025
1026 // executable
1027 s:=ToolOptions.Executable;
1028 if ToolOptions.ResolveMacros then begin
1029 if not GlobalMacroList.SubstituteStr(s) then begin
1030 debugln(['Error: (lazarus) [TExternalTools.RunToolAndDetach] ',ToolOptions.Title,' failed: macros of Executable: "',ToolOptions.Executable,'"']);
1031 exit;
1032 end;
1033 end;
1034 if not FilenameIsAbsolute(s) then begin
1035 // search in PATH
1036 if Proc.Environment.Count>0 then
1037 Path:=Proc.Environment.Values['PATH']
1038 else
1039 Path:=GetEnvironmentVariableUTF8('PATH');
1040 s:=SearchFileInPath(s,Proc.CurrentDirectory,
1041 Path, PathSeparator, sffFindProgramInPath);
1042 {$IFDEF Windows}
1043 if (s='') and (ExtractFileExt(s)='') then begin
1044 s:=SearchFileInPath(s+'.exe',Proc.CurrentDirectory,
1045 Path, PathSeparator,
1046 sffFindProgramInPath);
1047 end;
1048 {$ENDIF}
1049 if s='' then begin
1050 debugln(['Error: (lazarus) [TExternalTools.RunToolAndDetach] ',ToolOptions.Title,' failed: missing executable "',ToolOptions.Executable,'"']);
1051 exit;
1052 end;
1053 end;
1054 if not ( FilenameIsAbsolute(s) and FileExistsUTF8(s) ) then begin
1055 debugln(['Error: (lazarus) [TExternalTools.RunToolAndDetach] ',ToolOptions.Title,' failed: missing executable: "',s,'"']);
1056 exit;
1057 end;
1058 if DirectoryExistsUTF8(s) {$IFDEF DARWIN}and (ExtractFileExt(s)<>'.app'){$ENDIF} then begin
1059 debugln(['Error: (lazarus) [TExternalTools.RunToolAndDetach] ',ToolOptions.Title,' failed: executable is a directory: "',s,'"']);
1060 exit;
1061 end;
1062 if {$IFDEF DARWIN}(ExtractFileExt(s)<>'.app') and{$ENDIF} not FileIsExecutable(s) then begin
1063 debugln(['Error: (lazarus) [TExternalTools.RunToolAndDetach] ',ToolOptions.Title,' failed: executable lacks permission to run: "',s,'"']);
1064 exit;
1065 end;
1066
1067 {$IFDEF DARWIN}
1068 if DirectoryExistsUTF8(s) then
1069 begin
1070 Proc.Executable:='/usr/bin/open';
1071 s:=s+LineEnding+ToolOptions.CmdLineParams;
1072 end
1073 else
1074 {$ENDIF}
1075 begin
1076 Proc.Executable:=s;
1077 s:=ToolOptions.CmdLineParams;
1078 end;
1079
1080 // params
1081 if ToolOptions.ResolveMacros and not GlobalMacroList.SubstituteStr(s) then begin
1082 debugln(['Error: (lazarus) [TExternalTools.RunToolAndDetach] ',ToolOptions.Title,
1083 ' failed: macros in cmd line params "',ToolOptions.CmdLineParams,'"']);
1084 exit;
1085 end;
1086 sl:=TStringList.Create;
1087 try
1088 SplitCmdLineParams(s,sl);
1089 Proc.Parameters:=sl;
1090 finally
1091 sl.Free;
1092 end;
1093
1094 // run and detach
1095 if ToolOptions.ShowConsole then
1096 Proc.Options:=Proc.Options+[poNewConsole]-[poNoConsole]
1097 else
1098 Proc.Options:=Proc.Options-[poNewConsole]+[poNoConsole];
1099 if ToolOptions.HideWindow then
1100 Proc.ShowWindow:=swoHide
1101 else
1102 Proc.ShowWindow:=swoShow;
1103 try
1104 Proc.Execute;
1105 Result:=true;
1106 except
1107 end;
1108 finally
1109 Proc.Free;
1110 end;
1111 end;
1112
RunToolWithParsersnull1113 function TExternalTools.RunToolWithParsers(ToolOptions: TIDEExternalToolOptions): boolean;
1114 // run with parsers and messages
1115 var
1116 Tool: TAbstractExternalTool;
1117 i: Integer;
1118 begin
1119 {$IFDEF VerboseExtToolThread}
1120 debugln(['TExternalTools.RunToolWithParsers run with scanners ...']);
1121 {$ENDIF}
1122 Result:=false;
1123 Tool:=Add(ToolOptions.Title);
1124 Tool.Reference(Self,ClassName);
1125 try
1126 Tool.Hint:=ToolOptions.Hint;
1127 Tool.Process.CurrentDirectory:=ToolOptions.WorkingDirectory;
1128 Tool.Process.Executable:=ToolOptions.Executable;
1129 Tool.CmdLineParams:=ToolOptions.CmdLineParams;
1130 Tool.EnvironmentOverrides:=ToolOptions.EnvironmentOverrides;
1131 Assert(Assigned(ToolOptions.Parsers), 'TExternalTools.RunToolWithParsers: Parsers=Nil.');
1132 for i:=0 to ToolOptions.Parsers.Count-1 do
1133 Tool.AddParsers(ToolOptions.Parsers[i]);
1134 if ToolOptions.ShowConsole then
1135 Tool.Process.Options:=Tool.Process.Options+[poNewConsole]-[poNoConsole]
1136 else
1137 Tool.Process.Options:=Tool.Process.Options-[poNewConsole]+[poNoConsole];
1138 if ToolOptions.HideWindow then
1139 Tool.Process.ShowWindow:=swoHide
1140 else
1141 Tool.Process.ShowWindow:=swoShow;
1142 if ToolOptions.ResolveMacros and not Tool.ResolveMacros then begin
1143 debugln(['Error: (lazarus) [TExternalTools.RunToolWithParsers] failed to resolve macros']);
1144 exit;
1145 end;
1146 {$IFDEF VerboseExtToolThread}
1147 debugln(['TExternalTools.RunToolWithParsers Execute ',Tool.Title,' WD="',Tool.Process.CurrentDirectory,'" Exe="',Tool.Process.Executable,'" Params="',Tool.CmdLineParams,'" ...']);
1148 {$ENDIF}
1149 Tool.Execute;
1150 {$IFDEF VerboseExtToolThread}
1151 debugln(['TExternalTools.RunToolWithParsers WaitForExit ',Tool.Title,' ...']);
1152 {$ENDIF}
1153 Tool.WaitForExit;
1154 {$IFDEF VerboseExtToolThread}
1155 debugln(['TExternalTools.RunToolWithParsers Done ',Tool.Title]);
1156 {$ENDIF}
1157 Result:=(Tool.ErrorMessage='') and (not Tool.Terminated) and (Tool.ExitStatus=0);
1158 finally
1159 Tool.Release(Self);
1160 end;
1161 end;
1162
1163 procedure TExternalTools.FreeFinishedThreads;
1164 var
1165 i: Integer;
1166 aThread: TExternalToolThread;
1167 begin
1168 for i:=fOldThreads.Count-1 downto 0 do
1169 begin
1170 aThread:=TExternalToolThread(fOldThreads[i]);
1171 if aThread.Finished then
1172 begin
1173 fOldThreads.Delete(i);
1174 aThread.Free;
1175 end;
1176 end;
1177 end;
1178
1179 procedure TExternalTools.OnThreadTerminate(Sender: TObject);
1180 begin
1181 AddOldThread(TExternalToolThread(Sender));
1182 end;
1183
1184 procedure TExternalTools.AddOldThread(aThread: TExternalToolThread);
1185 var
1186 OldTool: TExternalTool;
1187 begin
1188 OldTool:=aThread.Tool;
1189 aThread.Tool:=nil;
1190 if fOldThreads.IndexOf(aThread)<0 then
1191 fOldThreads.Add(aThread);
1192
1193 if OldTool<>nil then
1194 OldTool.AutoFree;
1195 end;
1196
TExternalTools.GetRunningToolsnull1197 function TExternalTools.GetRunningTools(Index: integer): TExternalTool;
1198 begin
1199 EnterCriticalSection;
1200 try
1201 Result:=TExternalTool(fRunning[Index]);
1202 finally
1203 LeaveCriticalSection;
1204 end;
1205 end;
1206
1207 procedure TExternalTools.AddRunningTool(Tool: TExternalTool);
1208 begin
1209 EnterCriticalSection;
1210 try
1211 if fRunning.IndexOf(Tool)<0 then
1212 fRunning.Add(Tool);
1213 finally
1214 LeaveCriticalSection;
1215 end;
1216 end;
1217
1218 procedure TExternalTools.RemoveRunningTool(Tool: TExternalTool);
1219 begin
1220 EnterCriticalSection;
1221 try
1222 fRunning.Remove(Tool);
1223 finally
1224 LeaveCriticalSection;
1225 end;
1226 end;
1227
GetParsersnull1228 function TExternalTools.GetParsers(Index: integer): TExtToolParserClass;
1229 begin
1230 Result:=TExtToolParserClass(fParsers[Index]);
1231 end;
1232
1233 procedure TExternalTools.Notification(AComponent: TComponent; Operation: TOperation);
1234 begin
1235 inherited Notification(AComponent, Operation);
1236 if Operation=opRemove then begin
1237 EnterCriticalSection;
1238 try
1239 if fItems<>nil then
1240 fItems.Remove(AComponent);
1241 if fRunning<>nil then
1242 fRunning.Remove(AComponent);
1243 finally
1244 LeaveCriticalSection;
1245 end;
1246 end;
1247 end;
1248
1249 constructor TExternalTools.Create(aOwner: TComponent);
1250 begin
1251 inherited Create(aOwner);
1252 InitCriticalSection(FCritSec);
1253 fRunning:=TFPList.Create;
1254 fParsers:=TFPList.Create;
1255 fOldThreads:=TFPList.Create;
1256 MaxProcessCount:=DefaultMaxProcessCount;
1257 RunExternalTool := @RunExtToolHandler;
1258 end;
1259
1260 destructor TExternalTools.Destroy;
1261 begin
1262 RunExternalTool:=nil;
1263 TerminateAll;
1264 EnterCriticalSection;
1265 try
1266 if fRunning.Count>0 then
1267 raise Exception.Create('TExternalTools.Destroy some tools still running');
1268 inherited Destroy;
1269 FreeAndNil(fRunning);
1270 FreeAndNil(fParsers);
1271 FreeAndNil(fOldThreads);
1272 finally
1273 LeaveCriticalSection;
1274 end;
1275 DoneCriticalsection(FCritSec);
1276 end;
1277
Addnull1278 function TExternalTools.Add(Title: string): TAbstractExternalTool;
1279 begin
1280 Result:=FToolClass.Create(Self);
1281 Result.Title:=Title;
1282 fItems.Add(Result);
1283 end;
1284
IndexOfnull1285 function TExternalTools.IndexOf(Tool: TAbstractExternalTool): integer;
1286 begin
1287 Result:=fItems.IndexOf(Tool);
1288 end;
1289
TExternalTools.ParserCountnull1290 function TExternalTools.ParserCount: integer;
1291 begin
1292 Result:=fParsers.Count;
1293 end;
1294
1295 procedure TExternalTools.Work;
1296 var
1297 Tool: TExternalTool;
1298 begin
1299 while RunningCount<MaxProcessCount do begin
1300 Tool:=FindNextToolToStart;
1301 if Tool=nil then
1302 break;
1303 Tool.DoStart;
1304 end;
1305 FreeFinishedThreads;
1306 end;
1307
TExternalTools.FindNextToolToStartnull1308 function TExternalTools.FindNextToolToStart: TExternalTool;
1309 var
1310 Tool: TExternalTool;
1311 CurLoad: Int64;
1312 Load: Int64;
1313 i: Integer;
1314 begin
1315 Result:=nil;
1316 Load:=0;
1317 for i:=0 to Count-1 do begin
1318 Tool:=TExternalTool(Items[i]);
1319 //debugln(['TExternalTools.FindNextToolToExec ',Tool.Title,' ',Tool.CanStart]);
1320 if not Tool.CanStart then continue;
1321 CurLoad:=Tool.GetLongestEstimatedLoad;
1322 if (Result<>nil) and (Load>=CurLoad) then Continue;
1323 Result:=Tool;
1324 Load:=CurLoad;
1325 end;
1326 end;
1327
1328 procedure TExternalTools.Terminate(Tool: TExternalTool);
1329 begin
1330 if Tool=nil then exit;
1331 Tool.DoTerminate;
1332 end;
1333
1334 procedure TExternalTools.TerminateAll;
1335 // terminate all current tools
1336 var
1337 i: Integer;
1338 begin
1339 for i:=Count-1 downto 0 do
1340 Terminate(Items[i] as TExternalTool);
1341 FreeFinishedThreads;
1342 end;
1343
1344 procedure TExternalTools.Clear;
1345 begin
1346 TerminateAll;
1347 while Count>0 do
1348 Items[0].Free;
1349 end;
1350
RunningCountnull1351 function TExternalTools.RunningCount: integer;
1352 begin
1353 Result:=fRunning.Count;
1354 end;
1355
1356 procedure TExternalTools.EnterCriticalSection;
1357 begin
1358 System.EnterCriticalsection(FCritSec);
1359 end;
1360
1361 procedure TExternalTools.LeaveCriticalSection;
1362 begin
1363 System.LeaveCriticalsection(FCritSec);
1364 end;
1365
1366 procedure TExternalTools.RegisterParser(Parser: TExtToolParserClass);
1367 begin
1368 if fParsers.IndexOf(Parser)>=0 then exit;
1369 fParsers.Add(Parser);
1370 end;
1371
1372 procedure TExternalTools.UnregisterParser(Parser: TExtToolParserClass);
1373 begin
1374 if fParsers=nil then exit;
1375 fParsers.Remove(Parser);
1376 end;
1377
TExternalTools.FindParserForToolnull1378 function TExternalTools.FindParserForTool(const SubTool: string): TExtToolParserClass;
1379 var
1380 i: Integer;
1381 begin
1382 for i:=0 to fParsers.Count-1 do begin
1383 Result:=TExtToolParserClass(fParsers[i]);
1384 if Result.CanParseSubTool(SubTool) then exit;
1385 end;
1386 Result:=nil;
1387 end;
1388
TExternalTools.FindParserWithNamenull1389 function TExternalTools.FindParserWithName(const ParserName: string): TExtToolParserClass;
1390 var
1391 i: Integer;
1392 begin
1393 for i:=0 to fParsers.Count-1 do begin
1394 Result:=TExtToolParserClass(fParsers[i]);
1395 if SameText(Result.GetParserName,ParserName) then exit;
1396 end;
1397 Result:=nil;
1398 end;
1399
GetMsgToolnull1400 function TExternalTools.GetMsgTool(Msg: TMessageLine): TAbstractExternalTool;
1401 var
1402 CurOwner: TObject;
1403 View: TExtToolView;
1404 begin
1405 Result:=nil;
1406 if (Msg=nil) or (Msg.Lines=nil) then exit;
1407 CurOwner:=Msg.Lines.Owner;
1408 if CurOwner=nil then exit;
1409 if CurOwner is TAbstractExternalTool then
1410 Result:=TAbstractExternalTool(CurOwner)
1411 else if CurOwner is TExtToolView then begin
1412 View:=TExtToolView(CurOwner);
1413 Result:=View.Tool;
1414 end;
1415 end;
1416
1417 { TExternalToolThread }
1418
1419 procedure TExternalToolThread.SetTool(AValue: TExternalTool);
1420 var
1421 OldTool: TExternalTool;
1422 begin
1423 if FTool=AValue then Exit;
1424 OldTool:=FTool;
1425 FTool:=nil;
1426 if OldTool<>nil then
1427 OldTool.Thread:=nil;
1428 if AValue<>nil then
1429 begin
1430 FTool:=AValue;
1431 if FTool<>nil then
1432 FTool.Thread:=Self;
1433 end;
1434 end;
1435
1436 procedure TExternalToolThread.Execute;
1437 type
1438 TErrorFrame = record
1439 Addr: Pointer;
1440 Line: shortstring;
1441 end;
1442 PErrorFrame = ^TErrorFrame;
1443
1444 var
1445 ErrorFrames: array[0..30] of TErrorFrame;
1446 ErrorFrameCount: integer;
1447
GetExceptionStackTracenull1448 function GetExceptionStackTrace: string;
1449 var
1450 FrameCount: LongInt;
1451 Frames: PPointer;
1452 Cnt: LongInt;
1453 f: PErrorFrame;
1454 i: Integer;
1455 begin
1456 Result:='';
1457 FrameCount:=ExceptFrameCount;
1458 Frames:=ExceptFrames;
1459 ErrorFrames[0].Addr:=ExceptAddr;
1460 ErrorFrames[0].Line:='';
1461 ErrorFrameCount:=1;
1462 Cnt:=FrameCount;
1463 for i:=1 to Cnt do begin
1464 ErrorFrames[i].Addr:=Frames[i-1];
1465 ErrorFrames[i].Line:='';
1466 ErrorFrameCount:=i+1;
1467 end;
1468 for i:=0 to ErrorFrameCount-1 do begin
1469 f:=@ErrorFrames[i];
1470 try
1471 f^.Line:=copy(BackTraceStrFunc(f^.Addr),1,255);
1472 except
1473 f^.Line:=copy(SysBackTraceStr(f^.Addr),1,255);
1474 end;
1475 end;
1476 for i:=0 to ErrorFrameCount-1 do begin
1477 Result+=ErrorFrames[i].Line+LineEnding;
1478 end;
1479 end;
1480
1481 var
1482 Buf: string;
1483
ReadInputPipenull1484 function ReadInputPipe(aStream: TInputPipeStream; var LineBuf: string;
1485 IsStdErr: boolean): boolean;
1486 // true if some bytes have been read
1487 var
1488 Count: DWord;
1489 StartPos: Integer;
1490 i: DWord;
1491 begin
1492 Result:=false;
1493 if aStream=nil then exit;
1494 Count:=aStream.NumBytesAvailable;
1495 if Count=0 then exit;
1496 Count:=aStream.Read(Buf[1],Min(length(Buf),Count));
1497 if Count=0 then exit;
1498 Result:=true;
1499 StartPos:=1;
1500 i:=1;
1501 while i<=Count do begin
1502 if Buf[i] in [#10,#13] then begin
1503 LineBuf:=LineBuf+copy(Buf,StartPos,i-StartPos);
1504 if IsStdErr then
1505 fLines.AddObject(LineBuf,fLines)
1506 else
1507 fLines.Add(LineBuf);
1508 LineBuf:='';
1509 if (i<Count) and (Buf[i+1] in [#10,#13]) and (Buf[i]<>Buf[i+1])
1510 then
1511 inc(i);
1512 StartPos:=i+1;
1513 end;
1514 inc(i);
1515 end;
1516 LineBuf:=LineBuf+copy(Buf,StartPos,Count-StartPos+1);
1517 end;
1518
1519 const
1520 UpdateTimeDiff = 1000 div 5; // update five times a second, even if there is still work
1521 var
1522 {$IFDEF VerboseExtToolThread}
1523 Title: String;
1524 {$ENDIF}
1525 OutputLine, StdErrLine: String;
1526 LastUpdate: QWord;
1527 ErrMsg: String;
1528 ok: Boolean;
1529 HasOutput: Boolean;
1530 begin
1531 {$IFDEF VerboseExtToolThread}
1532 Title:=Tool.Title;
1533 {$ENDIF}
1534 if Tool.Thread<>Self then
1535 raise Exception.Create('');
1536 SetLength(Buf{%H-},4096);
1537 ErrorFrameCount:=0;
1538 fLines:=TStringList.Create;
1539 try
1540 try
1541 if Tool.Stage<>etsStarting then begin
1542 {$IFDEF VerboseExtToolThread}
1543 DebuglnThreadLog(['TExternalToolThread.Execute ',Title,' Tool.Stage=',dbgs(Tool.Stage),' aborting']);
1544 {$ENDIF}
1545 exit;
1546 end;
1547
1548 {$IFDEF VerboseExtToolThread}
1549 DebuglnThreadLog(['TExternalToolThread.Execute ',Title,' check executing "',Tool.Process.Executable,'" ...']);
1550 {$ENDIF}
1551
1552 if not FileIsExecutable(Tool.Process.Executable) then begin
1553 Tool.ErrorMessage:=Format(lisCanNotExecute, [Tool.Process.Executable]);
1554 Tool.ProcessStopped;
1555 exit;
1556 end;
1557 if not DirectoryExistsUTF8(ChompPathDelim(Tool.Process.CurrentDirectory))
1558 then begin
1559 Tool.ErrorMessage:=Format(lisMissingDirectory, [Tool.Process.
1560 CurrentDirectory]);
1561 Tool.ProcessStopped;
1562 exit;
1563 end;
1564
1565 // Under Unix TProcess uses fpFork, which means the current thread is
1566 // duplicated. One is the old thread and one runs fpExecve.
1567 // If fpExecve runs, then it will not return.
1568 // If fpExecve fails it returns via an exception and this thread runs twice.
1569 ok:=false;
1570 try
1571 {$IFDEF VerboseExtToolThread}
1572 DebuglnThreadLog(['TExternalToolThread.Execute ',Title,' execute ...']);
1573 {$ENDIF}
1574 // now execute
1575 Tool.Process.PipeBufferSize:=Max(Tool.Process.PipeBufferSize,64*1024);
1576 Tool.Process.Execute;
1577 {$IFDEF VerboseExtToolThread}
1578 DebuglnThreadLog(['TExternalToolThread.Execute ',Title,' executing ...']);
1579 {$ENDIF}
1580 ok:=true;
1581 except
1582 on E: Exception do begin
1583 // BEWARE: we are now either in the normal thread or in the failed forked thread
1584 {$IFDEF VerboseExtToolThread}
1585 DebuglnThreadLog(['TExternalToolThread.Execute ',Title,' execute failed: ',E.Message]);
1586 {$ENDIF}
1587 if Tool.ErrorMessage='' then
1588 Tool.ErrorMessage:=Format(lisUnableToExecute, [E.Message]);
1589 end;
1590 end;
1591 // BEWARE: we are now either in the normal thread or in the failed forked thread
1592 if not ok then begin
1593 Tool.ProcessStopped;
1594 exit;
1595 end;
1596 // we are now in the normal thread
1597 if Tool.Stage>=etsStopped then
1598 exit;
1599 {$IFDEF VerboseExtToolThread}
1600 DebuglnThreadLog(['TExternalToolThread.Execute ',Title,' ProcessRunning ...']);
1601 {$ENDIF}
1602 Tool.ProcessRunning;
1603 if Tool.Stage>=etsStopped then
1604 exit;
1605 {$IFDEF VerboseExtToolThread}
1606 DebuglnThreadLog(['TExternalToolThread.Execute ',Title,' reading ...']);
1607 {$ENDIF}
1608
1609 OutputLine:='';
1610 StdErrLine:='';
1611 LastUpdate:=GetTickCount64;
1612 while (Tool<>nil) and (Tool.Stage=etsRunning) do begin
1613 if Tool.ReadStdOutBeforeErr then begin
1614 HasOutput:=ReadInputPipe(Tool.Process.Output,OutputLine,false)
1615 or ReadInputPipe(Tool.Process.Stderr,StdErrLine,true);
1616 end else begin
1617 HasOutput:=ReadInputPipe(Tool.Process.Stderr,StdErrLine,true)
1618 or ReadInputPipe(Tool.Process.Output,OutputLine,false);
1619 end;
1620 if (not HasOutput) then begin
1621 // no more pending output
1622 if not Tool.Process.Running then break;
1623 end;
1624 if (fLines.Count>0)
1625 and (Abs(int64(GetTickCount64)-LastUpdate)>UpdateTimeDiff) then begin
1626 {$IFDEF VerboseExtToolThread}
1627 DebuglnThreadLog(['TExternalToolThread.Execute ',Title,' ',TimeToStr(Now),' ',IntToStr(GetTickCount64),' AddOutputLines ...']);
1628 {$ENDIF}
1629 Tool.AddOutputLines(fLines);
1630 {$IFDEF VerboseExtToolThread}
1631 DebuglnThreadLog(['TExternalToolThread.Execute ',Title,' AddOutputLines ok']);
1632 {$ENDIF}
1633 fLines.Clear;
1634 LastUpdate:=GetTickCount64;
1635 end;
1636 if (not HasOutput) then begin
1637 // no more pending output and process is still running
1638 // => tool needs some time
1639 Sleep(50);
1640 end;
1641 end;
1642 {$IFDEF VerboseExtToolThread}
1643 DebuglnThreadLog(['TExternalToolThread.Execute ',Title,' end reading']);
1644 {$ENDIF}
1645 // add rest of output
1646 if (OutputLine<>'') then
1647 fLines.Add(OutputLine);
1648 if (StdErrLine<>'') then
1649 fLines.Add(StdErrLine);
1650 if (Tool<>nil) and (fLines.Count>0) then begin
1651 {$IFDEF VerboseExtToolThread}
1652 DebuglnThreadLog(['TExternalToolThread.Execute ',Title,' final AddOutputLines ...']);
1653 {$ENDIF}
1654 Tool.AddOutputLines(fLines);
1655 {$IFDEF VerboseExtToolThread}
1656 DebuglnThreadLog(['TExternalToolThread.Execute ',Title,' final AddOutputLines ok']);
1657 {$ENDIF}
1658 fLines.Clear;
1659 end;
1660 try
1661 if Tool.Stage>=etsStopped then begin
1662 {$IFDEF VerboseExtToolThread}
1663 DebuglnThreadLog(['TExternalToolThread.Execute ',Title,' not reading exit status, because already stopped']);
1664 {$ENDIF}
1665 exit;
1666 end;
1667 {$IFDEF VerboseExtToolThread}
1668 DebuglnThreadLog(['TExternalToolThread.Execute ',Title,' reading exit status ...']);
1669 {$ENDIF}
1670 Tool.ExitStatus:=Tool.Process.ExitStatus;
1671 Tool.ExitCode:=Tool.Process.ExitCode;
1672 {$IFDEF VerboseExtToolThread}
1673 if Tool.ExitStatus<>0 then
1674 DebuglnThreadLog(['TExternalToolThread.Execute ',Title,' exit status=',Tool.ExitStatus,' ExitCode=',Tool.ExitCode]);
1675 {$ENDIF}
1676 except
1677 Tool.ErrorMessage:=lisUnableToReadProcessExitStatus;
1678 end;
1679 except
1680 on E: Exception do begin
1681 {$IFDEF VerboseExtToolThread}
1682 DebuglnThreadLog(['TExternalToolThread.Execute ',Title,' run: ',E.Message]);
1683 {$ENDIF}
1684 if (Tool<>nil) and (Tool.ErrorMessage='') then begin
1685 Tool.ErrorMessage:=E.Message;
1686 ErrMsg:=GetExceptionStackTrace;
1687 {$IFDEF VerboseExtToolErrors}
1688 DebuglnThreadLog(ErrMsg);
1689 {$ENDIF}
1690 Tool.ErrorMessage:=E.Message+LineEnding+ErrMsg;
1691 end;
1692 end;
1693 end;
1694 finally
1695 {$IFDEF VerboseExtToolThread}
1696 if fLines<>nil then
1697 DebuglnThreadLog(['TExternalToolThread.Execute ',Title,' cleaning up']);
1698 {$ENDIF}
1699 // clean up
1700 try
1701 FreeAndNil(fLines);
1702 except
1703 on E: Exception do begin
1704 {$IFDEF VerboseExtToolThread}
1705 DebuglnThreadLog(['TExternalToolThread.Execute adding pending messages: ',E.Message]);
1706 {$ENDIF}
1707 if Tool<>nil then
1708 Tool.ErrorMessage:=Format(lisFreeingBufferLines, [E.Message]);
1709 end;
1710 end;
1711 end;
1712 if Tool.Stage>=etsStopped then begin
1713 {$IFDEF VerboseExtToolThread}
1714 DebuglnThreadLog(['TExternalToolThread.Execute ',Title,' not cleaning up']);
1715 {$ENDIF}
1716 exit;
1717 end;
1718 {$IFDEF VerboseExtToolThread}
1719 DebuglnThreadLog(['TExternalToolThread.Execute ',Title,' ProcessStopped ...']);
1720 {$ENDIF}
1721 Tool.ProcessStopped;
1722 {$IFDEF VerboseExtToolThread}
1723 DebuglnThreadLog(['TExternalToolThread.Execute ',Title,' Thread END']);
1724 {$ENDIF}
1725 end;
1726
1727 procedure TExternalToolThread.DebuglnThreadLog(const Args: array of const);
1728 begin
1729 debugln(Args);
1730 end;
1731
1732 destructor TExternalToolThread.Destroy;
1733 begin
1734 Tool:=nil;
1735 inherited Destroy;
1736 end;
1737
1738 end.
1739
1740