Bladeren bron

Fix error when logging process output

John Stevenson 1 jaar geleden
bovenliggende
commit
8472404ce9
6 gewijzigde bestanden met toevoegingen van 56 en 44 verwijderingen
  1. 5 1
      Examples/PowerShell.iss
  2. 10 3
      ISHelp/isxfunc.xml
  3. 3 3
      Projects/ISPP/IsppFuncs.pas
  4. 32 28
      Projects/Src/CmnFunc2.pas
  5. 3 6
      Projects/Src/Compile.pas
  6. 3 3
      Projects/Src/InstFunc.pas

+ 5 - 1
Examples/PowerShell.iss

@@ -59,7 +59,11 @@ end;
 function ExecAndGetFirstLine(const Filename, Params, WorkingDir: String; var ResultCode: Integer): String;
 begin
   Line := '';
-  ExecAndLogOutput(Filename, Params, WorkingDir, SW_SHOWNORMAL, ewWaitUntilTerminated, ResultCode, @ExecAndGetFirstLineLog);
+  try
+    ExecAndLogOutput(Filename, Params, WorkingDir, SW_SHOWNORMAL, ewWaitUntilTerminated, ResultCode, @ExecAndGetFirstLineLog);
+  except
+    Log(GetExceptionMessage);
+  end;
   Result := Line;
 end;
 

+ 10 - 3
ISHelp/isxfunc.xml

@@ -2874,10 +2874,13 @@ end;</pre></example>
         <description><p>Identical to <link topic="isxfunc_Exec">Exec</link> except:</p>
 <p>Console programs are always hidden and the ShowCmd parameter only affects GUI programs, so always using <tt>SW_SHOWNORMAL</tt> instead of <tt>SW_HIDE</tt> is recommended.</p>
 <p>If OnLog is set to <tt>nil</tt> then the output of the executed executable or batch file is logged in Setup's or Uninstall's log file and/or in the Compiler IDE's "Debug Output" view.</p>
-<p>If OnLog is not set to <tt>nil</tt> then the output is sent to the specified function, line by line.</p></description>
+<p>If OnLog is not set to <tt>nil</tt> then the output is sent to the specified function, line by line.</p>
+<p>An exception will be raised if there was an error setting up output redirection.</p></description>
         <remarks><p>Parameter <tt>Wait</tt> must always be set to <tt>ewWaitUntilTerminated</tt> when calling this function.</p>
 <p>TOnLog is defined as:</p>
-<p><tt>TOnLog = procedure(const S: String; const Error, FirstLine: Boolean);</tt></p></remarks>
+<p><tt>TOnLog = procedure(const S: String; const Error, FirstLine: Boolean);</tt></p>
+<p>Parameter S is the output line when Error is False, otherwise an error message. FirstLine is True if this is the first line of output from the program, otherwise False.</p>
+<p>Error will be True if setting up output redirection or reading the output failed, or if the output size exceeded 10mb. There is no further output after an error.</p></remarks>
         <example><pre>var
   Line: String;
 
@@ -2893,7 +2896,11 @@ end;
 function ExecAndGetFirstLine(const Filename, Params, WorkingDir: String; var ResultCode: Integer): String;
 begin
   Line := '';
-  ExecAndLogOutput(Filename, Params, WorkingDir, SW_SHOWNORMAL, ewWaitUntilTerminated, ResultCode, @ExecAndGetFirstLineLog);
+  try
+    ExecAndLogOutput(Filename, Params, WorkingDir, SW_SHOWNORMAL, ewWaitUntilTerminated, ResultCode, @ExecAndGetFirstLineLog);
+  except
+    Log(GetExceptionMessage);
+  end;
   Result := Line;
 end;</pre></example>
         <seealso><p><link topic="isxfunc_Exec">Exec</link></p></seealso>

+ 3 - 3
Projects/ISPP/IsppFuncs.pas

@@ -676,9 +676,9 @@ begin
 
     if Log and Assigned(LogProc) and WaitUntilTerminated then begin
       OutputReader := TCreateProcessOutputReader.Create(LogProc, LogProcData);
-      OutputReader.UpdateStartupInfo(StartupInfo, InheritHandles);
-      if InheritHandles then
-        dwCreationFlags := dwCreationFlags or CREATE_NO_WINDOW;
+      OutputReader.UpdateStartupInfo(StartupInfo);
+      InheritHandles := True;
+      dwCreationFlags := dwCreationFlags or CREATE_NO_WINDOW;
     end;
 
     Result := CreateProcess(nil, PChar(CmdLine), nil, nil, InheritHandles,

+ 32 - 28
Projects/Src/CmnFunc2.pas

@@ -48,13 +48,13 @@ type
     FLogProcData: NativeInt;
     FReadBuffer: AnsiString;
     FNextLineIsFirstLine: Boolean;
+    FLastErrorMessage: String;
     procedure CloseAndClearHandle(var Handle: THandle);
     procedure LogErrorFmt(const S: String; const Args: array of const);
   public
     constructor Create(const ALogProc: TLogProc; const ALogProcData: NativeInt);
     destructor Destroy; override;
-    procedure UpdateStartupInfo(var StartupInfo: TStartupInfo;
-      var InheritHandles: Boolean);
+    procedure UpdateStartupInfo(var StartupInfo: TStartupInfo);
     procedure NotifyCreateProcessDone;
     procedure Read(const LastRead: Boolean);
     property MaxTotalBytesToRead: Cardinal read FMaxTotalBytesToRead write FMaxTotalBytesToRead;
@@ -1615,24 +1615,29 @@ begin
   var NulDevice := CreateFile('\\.\NUL', GENERIC_READ,
     FILE_SHARE_READ or FILE_SHARE_WRITE, @SecurityAttributes,
     OPEN_EXISTING, 0, 0);
-  if NulDevice = INVALID_HANDLE_VALUE then
-    LogErrorFmt('CreateFile failed (%d).', [GetLastError])
-  else
-    FStdInNulDevice := NulDevice;
+  if NulDevice = INVALID_HANDLE_VALUE then begin
+    LogErrorFmt('CreateFile failed (%d).', [GetLastError]);
+    Exit;
+  end;
+
+  FStdInNulDevice := NulDevice;
 
   var PipeRead, PipeWrite: THandle;
-  if not CreatePipe(PipeRead, PipeWrite, @SecurityAttributes, 0) then
-    LogErrorFmt('CreatePipe failed (%d).', [GetLastError])
-  else begin
-    FStdOutPipeRead := PipeRead;
-    FStdOutPipeWrite := PipeWrite;
-    if not SetHandleInformation(FStdOutPipeRead, HANDLE_FLAG_INHERIT, 0) then
-      LogErrorFmt('SetHandleInformation failed (%d).', [GetLastError]);
+  if not CreatePipe(PipeRead, PipeWrite, @SecurityAttributes, 0) then begin
+    LogErrorFmt('CreatePipe failed (%d).', [GetLastError]);
+    Exit;
   end;
 
-  FCreatedHandles := (FStdInNulDevice <> 0) and (FStdOutPipeRead <> 0) and
-    (FStdOutPipeWrite <> 0);
-  FOKToRead := FCreatedHandles;
+  if not SetHandleInformation(PipeRead, HANDLE_FLAG_INHERIT, 0) then begin
+    LogErrorFmt('SetHandleInformation failed (%d).', [GetLastError]);
+    Exit;
+  end;
+
+  FStdOutPipeRead := PipeRead;
+  FStdOutPipeWrite := PipeWrite;
+
+  FCreatedHandles := True;
+  FOKToRead := True;
   FMaxTotalBytesToRead := 10*1024*1024;
 end;
 
@@ -1654,20 +1659,19 @@ end;
 
 procedure TCreateProcessOutputReader.LogErrorFmt(const S: String; const Args: array of const);
 begin
-  FLogProc(Format(S, Args), False, True, FLogProcData);
+  FLastErrorMessage := Format(S, Args);
+  FLogProc('OutputReader: ' + FLastErrorMessage, True, False, FLogProcData);
 end;
 
-procedure TCreateProcessOutputReader.UpdateStartupInfo(var StartupInfo: TStartupInfo;
-  var InheritHandles: Boolean);
+procedure TCreateProcessOutputReader.UpdateStartupInfo(var StartupInfo: TStartupInfo);
 begin
-  if FCreatedHandles then begin
-    StartupInfo.dwFlags := StartupInfo.dwFlags or STARTF_USESTDHANDLES;
-    StartupInfo.hStdInput := FStdInNulDevice;
-    StartupInfo.hStdOutput := FStdOutPipeWrite;
-    StartupInfo.hStdError := FStdOutPipeWrite;
-    InheritHandles := True;
-  end else
-    InheritHandles := False;
+  if not FCreatedHandles then
+    raise Exception.Create(Format('Output redirection error: %s', [FLastErrorMessage]));
+
+  StartupInfo.dwFlags := StartupInfo.dwFlags or STARTF_USESTDHANDLES;
+  StartupInfo.hStdInput := FStdInNulDevice;
+  StartupInfo.hStdOutput := FStdOutPipeWrite;
+  StartupInfo.hStdError := FStdOutPipeWrite;
 end;
 
 procedure TCreateProcessOutputReader.NotifyCreateProcessDone;
@@ -1704,7 +1708,7 @@ begin
     if not FOKToRead then begin
       var LastError := GetLastError;
       if LastError <> ERROR_BROKEN_PIPE then
-        LogErrorFmt('PeekNamedPipe failed (%d).', [GetLastError]);
+        LogErrorFmt('PeekNamedPipe failed (%d).', [LastError]);
     end else if TotalBytesAvail > 0 then begin
       { Don't read more than our read limit }
       if TotalBytesAvail > FMaxTotalBytesToRead - FTotalBytesRead then

+ 3 - 6
Projects/Src/Compile.pas

@@ -7389,12 +7389,9 @@ procedure TSetupCompiler.SignCommand(const AName, ACommand, AParams, AExeFilenam
 
     var OutputReader := TCreateProcessOutputReader.Create(SignCommandLog, NativeInt(Self));
     try
-      var InheritHandles: Boolean;
-      var dwCreationFlags: DWORD := CREATE_DEFAULT_ERROR_MODE;
-
-      OutputReader.UpdateStartupInfo(StartupInfo, InheritHandles);
-      if InheritHandles then
-        dwCreationFlags := dwCreationFlags or CREATE_NO_WINDOW;
+      var InheritHandles := True;
+      var dwCreationFlags: DWORD := CREATE_DEFAULT_ERROR_MODE or CREATE_NO_WINDOW;
+      OutputReader.UpdateStartupInfo(StartupInfo);
 
       if not CreateProcess(nil, PChar(AFormattedCommand), nil, nil, InheritHandles,
          dwCreationFlags, nil, PChar(CompilerDir), StartupInfo, ProcessInfo) then begin

+ 3 - 3
Projects/Src/InstFunc.pas

@@ -953,9 +953,9 @@ begin
 
     if Log and Assigned(LogProc) and (Wait = ewWaitUntilTerminated) then begin
       OutputReader := TCreateProcessOutputReader.Create(LogProc, LogProcData);
-      OutputReader.UpdateStartupInfo(StartupInfo, InheritHandles);
-      if InheritHandles then
-        dwCreationFlags := dwCreationFlags or CREATE_NO_WINDOW;
+      OutputReader.UpdateStartupInfo(StartupInfo);
+      InheritHandles := True;
+      dwCreationFlags := dwCreationFlags or CREATE_NO_WINDOW;
     end;
 
     Result := CreateProcessRedir(DisableFsRedir, nil, PChar(CmdLine), nil, nil,