ISCC.dpr

program ISCC;
{$APPTYPE CONSOLE}

{
  Inno Setup
  Copyright (C) 1997-2016 Jordan Russell
  Portions by Martijn Laan
  For conditions of distribution and use, see LICENSE.TXT.

  Command-line compiler
}

{x$DEFINE STATICCOMPILER}
{ For debugging purposes, remove the 'x' to have it link the compiler code
  into this program and not depend on ISCmplr.dll. }

uses
  SafeDLLPath in 'SafeDLLPath.pas',
  Windows, SysUtils, Classes,
  {$IFDEF STATICCOMPILER} Compile, {$ENDIF}
  PathFunc, CmnFunc2, CompInt, FileClass, CompTypes;

{$R *.res}
{$R ISCC.manifest.res}

{$I VERSION.INC}

type
  PScriptLine = ^TScriptLine;
  TScriptLine = record
    LineText: String;
    Next: PScriptLine;
  end;

  TOptionID = 0..25;

  TOptions = packed set of TOptionID;

  TIsppOptions = packed record
    ParserOptions: TOptions;
    Options: TOptions;
    VerboseLevel: Byte;
    InlineStart: string[7];
    InlineEnd: string[7];
    SpanSymbol: AnsiChar;
  end;

var
  StdOutHandle, StdErrHandle: THandle;
  ScriptFilename: String;
  Definitions, IncludePath, IncludeFiles, Output, OutputPath, OutputFilename: String;
  SignTools: TStringList;
  ScriptLines, NextScriptLine: PScriptLine;
  CurLine: String;
  StartTime, EndTime: DWORD;
  Quiet, ShowProgress, WantAbort: Boolean;
  ProgressPoint: TPoint;
  LastProgress: String;
  IsppOptions: TIsppOptions;
  IsppMode: Boolean;

procedure WriteToStdHandle(const H: THandle; S: AnsiString);
var
  BytesWritten: DWORD;
begin
  if Copy(S, 1, 1) <> #13 then S := S + #13#10;
  WriteFile(H, S[1], Length(S), BytesWritten, nil);
end;

procedure WriteStdOut(const S: String);
begin
  WriteToStdHandle(StdOutHandle, AnsiString(S));
end;

procedure WriteStdErr(const S: String);
begin
  WriteToStdHandle(StdErrHandle, AnsiString(S));
end;

function GetCursorPos: TPoint;
var
  CSBI: TConsoleScreenBufferInfo;
begin
  if not GetConsoleScreenBufferInfo(StdOutHandle, CSBI) then
    Exit;
  Result.X := CSBI.dwCursorPosition.X;
  Result.Y := CSBI.dwCursorPosition.Y;
end;

procedure SetCursorPos(const P: TPoint);
var
  Coords: TCoord;
  CSBI: TConsoleScreenBufferInfo;
begin
  if not GetConsoleScreenBufferInfo(StdOutHandle, CSBI) then
    Exit;
  if P.X < 0 then Exit;
  if P.Y < 0 then Exit;
  if P.X > CSBI.dwSize.X then Exit;
  if P.Y > CSBI.dwSize.Y then Exit;
  Coords.X := P.X;
  Coords.Y := P.Y;
  SetConsoleCursorPosition(StdOutHandle, Coords);
end;

procedure WriteProgress(const S: String);
var
  CSBI: TConsoleScreenBufferInfo;
  Str: String;
begin
  if GetConsoleScreenBufferInfo(StdOutHandle, CSBI) then
  begin
    if Length(S) > CSBI.dwSize.X then
      Str := Copy(S, 1, CSBI.dwSize.X)
    else
      Str := Format('%-' + IntToStr(CSBI.dwSize.X) + 's', [S]);
  end
  else
    Str := S;

  WriteToStdHandle(StdOutHandle, AnsiString(Str));
end;

function ConsoleCtrlHandler(dwCtrlType: DWORD): BOOL; stdcall;
begin
  { Abort gracefully when Ctrl+C/Break is pressed }
  WantAbort := True;
  Result := True;
end;

procedure ReadScriptLines(const F: TTextFileReader);
var
  LineNumber: Integer;
  PrevLine, L: PScriptLine;
begin
  LineNumber := 1;
  PrevLine := nil;
  while not F.Eof do begin
    New(L);
    try
      L.LineText := F.ReadLine;
      if Pos(#0, L.LineText) <> 0 then
        raise Exception.CreateFmt('Illegal null character on line %d', [LineNumber]);
      L.Next := nil;
    except
      Dispose(L);
      raise;
    end;
    if Assigned(PrevLine) then
      PrevLine.Next := L
    else begin
      ScriptLines := L;
      NextScriptLine := L;
    end;
    PrevLine := L;
    Inc(LineNumber);
  end;
end;

procedure FreeScriptLines;
var
  L, NextLine: PScriptLine;
begin
  L := ScriptLines;
  ScriptLines := nil;
  NextScriptLine := nil;
  while Assigned(L) do begin
    NextLine := L.Next;
    Dispose(L);
    L := NextLine;
  end;
end;

function CompilerCallbackProc(Code: Integer; var Data: TCompilerCallbackData;
  AppData: Longint): Integer; stdcall;

  procedure PrintProgress(Progress: String);
  var
    Pt: TPoint;
  begin
    if (Progress = '') or (LastProgress = Progress) then
      Exit;

    Pt := GetCursorPos;

    if Pt.Y <= ProgressPoint.Y then
      Exit
    else if ProgressPoint.X < 0 then begin
      ProgressPoint := Pt;
      WriteStdOut('');
      Pt := GetCursorPos;
    end;

    SetCursorPos(ProgressPoint);
    WriteProgress(#13 + Progress);
    LastProgress := Progress;
    SetCursorPos(Pt);
  end;

var
  S, BytesCompressedPerSecond, SecondsRemaining: String;
begin
  if WantAbort then begin
    Result := iscrRequestAbort;
    Exit;
  end;
  Result := iscrSuccess;
  case Code of
    iscbReadScript: begin
        { Note: In Inno Setup 3.0.1 and later we can ignore Data.Reset since
          it is only True once (when reading the first line). }
        if Assigned(NextScriptLine) then begin
          CurLine := NextScriptLine.LineText;
          NextScriptLine := NextScriptLine.Next;
          Data.LineRead := PChar(CurLine);
        end;
      end;
    iscbNotifyStatus:
      if not Quiet then
        WriteStdOut(Data.StatusMsg)
      else if ShowProgress then
        PrintProgress(Trim(Data.StatusMsg));
    iscbNotifySuccess: begin
        EndTime := GetTickCount;
        if not Quiet then begin
          WriteStdOut('');
          if Data.OutputExeFilename <> '' then begin
            WriteStdOut(Format('Successful compile (%.3f sec). ' +
              'Resulting Setup program filename is:',
              [(EndTime - StartTime) / 1000]));
            WriteStdOut(Data.OutputExeFilename);
          end else
            WriteStdOut(Format('Successful compile (%.3f sec). ' +
              'Output was disabled.',
              [(EndTime - StartTime) / 1000]));
        end;
      end;
    iscbNotifyError:
      if Assigned(Data.ErrorMsg) then begin
        S := 'Error';
        if Data.ErrorLine <> 0 then
          S := S + Format(' on line %d', [Data.ErrorLine]);
        if Assigned(Data.ErrorFilename) then
          S := S + ' in ' + Data.ErrorFilename
        else if ScriptFilename <> '' then
          S := S + ' in ' + ScriptFilename;
        S := S + ': ' + Data.ErrorMsg;
        WriteStdErr(S);
      end;
    iscbNotifyIdle:
      if ShowProgress and (Data.CompressProgress <> 0) then begin
        if Data.BytesCompressedPerSecond <> 0 then
          BytesCompressedPerSecond := Format(' at %.2f kb/s', [Data.BytesCompressedPerSecond / 1024])
        else
          BytesCompressedPerSecond := '';
        if Data.SecondsRemaining <> -1 then
          SecondsRemaining := Format(', %d seconds remaining', [Data.SecondsRemaining])
        else
          SecondsRemaining := '';
        PrintProgress(Format('Compressing: %.2f%% done%s%s', [Data.CompressProgress / Data.CompressProgressMax * 100, BytesCompressedPerSecond, SecondsRemaining]));
      end;
  end;
end;

procedure ProcessCommandLine;

  procedure SetOption(var Options: TOptions; Option: Char; Value: Boolean);
  begin
    if Value then
      Include(Options, Ord(UpCase(Option)) - Ord('A'))
    else
      Exclude(Options, Ord(UpCase(Option)) - Ord('A'))
  end;

  procedure InitIsppOptions(var Opt: TIsppOptions; var Definitions, IncludePath, IncludeFiles: String);
  begin
    with Opt do begin
      SetOption(Options, 'C', True);
      SetOption(ParserOptions, 'B', True);
      SetOption(ParserOptions, 'P', True);
      VerboseLevel := 0;
      InlineStart := '{#';
      InlineEnd := '}';
    end;

    Definitions := 'ISPPCC_INVOKED'#1;
    IncludePath := ExtractFileDir(NewParamStr(0));
    IncludeFiles := '';
  end;

  procedure ReadOptionsParam(var Options: TOptions; Symbol: Char);
  var
    I: Integer;
    S: String;
  begin
    for I := 1 to NewParamCount do
    begin
      S := NewParamStr(I);
      if Length(S) = 4 then
        if ((S[1] = '/') or (S[1] = '-')) and (UpCase(S[2]) = Symbol) then
          case S[4] of
            '-': SetOption(Options, S[3], False);
            '+': SetOption(Options, S[3], True)
          else
            raise Exception.CreateFmt('Invalid command line option: %s', [S]);
          end;
    end;
  end;

  function IsParam(const S: String): Boolean;
  begin
    Result := (Length(S) >= 2) and ((S[1] = '/') or (S[1] = '-'));
  end;

  function GetParam(var S: String; Symbols: String): Boolean;
  begin
    Result := IsParam(S) and
      (CompareText(Copy(S, 2, Length(Symbols)), Symbols) = 0);
    if Result then
      S := Copy(S, 2 + Length(Symbols), MaxInt);
  end;

  function FindParam(var Index: Integer; Symbols: String): String;
  var
    I: Integer;
    S: String;
  begin
    for I := Index to NewParamCount do
    begin
      S := NewParamStr(I);
      if IsParam(S) and (CompareText(Copy(S, 2, Length(Symbols)), Symbols) = 0) then
      begin
        Result := Copy(S, 2 + Length(Symbols), MaxInt);
        Index := I + 1;
        Exit;
      end;
    end;
    Index := MaxInt;
    Result := '';
  end;

  procedure ShowBanner;
  begin
    WriteStdOut('Inno Setup 5 Command-Line Compiler');
    WriteStdOut('Copyright (C) 1997-2016 Jordan Russell. All rights reserved.');
    WriteStdOut('Portions Copyright (C) 2000-2016 Martijn Laan');
    if IsppMode then begin
      WriteStdOut('Inno Setup Preprocessor');
      WriteStdOut('Copyright (C) 2001-2004 Alex Yackimoff. All rights reserved.');
    end;
    WriteStdOut('');
  end;

  procedure ShowUsage;
  begin
    WriteStdErr('Usage:  iscc [options] scriptfile.iss');
    WriteStdErr('or to read from standard input:  iscc [options] -');
    WriteStdErr('Options:');
    WriteStdErr('  /O(+|-)            Enable or disable output (overrides Output)');
    WriteStdErr('  /O<path>           Output files to specified path (overrides OutputDir)');
    WriteStdErr('  /F<filename>       Overrides OutputBaseFilename with the specified filename');
    WriteStdErr('  /S<name>=<command> Sets a SignTool with the specified name and command');
    WriteStdErr('  /Q                 Quiet compile (print error messages only)');
    WriteStdErr('  /Qp                Enable quiet compile while still displaying progress');
    if IsppMode then begin
      WriteStdErr('  /D<name>[=<value>] Emulate #define public <name> <value>');
      WriteStdErr('  /$<letter>(+|-)    Emulate #pragma option -<letter>(+|-)');
      WriteStdErr('  /P<letter>(+|-)    Emulate #pragma parseroption -<letter>(+|-)');
      WriteStdErr('  /I<paths>          Emulate #pragma include <paths>');
      WriteStdErr('  /J<filename>       Emulate #include <filename>');
      WriteStdErr('  /{#<string>        Emulate #pragma inlinestart <string>');
      WriteStdErr('  /}<string>         Emulate #pragma inlineend <string>');
      WriteStdErr('  /V<number>         Emulate #pragma verboselevel <number>');
    end;
    WriteStdErr('  /?                 Show this help screen');
    if IsppMode then begin
      WriteStdErr('');
      WriteStdErr('Example: iscc /$c- /Pu+ "/DLic=Trial Lic.txt" /IC:\INC;D:\INC scriptfile.iss');
      WriteStdErr('');
    end;
  end;

var
  I: Integer;
  S: String;
begin
  if IsppMode then begin
    InitIsppOptions(IsppOptions, Definitions, IncludePath, IncludeFiles);
    { Also see below }
    ReadOptionsParam(IsppOptions.Options, '$');
    ReadOptionsParam(IsppOptions.ParserOptions, 'P');
  end;

  for I := 1 to NewParamCount do begin
    S := NewParamStr(I);
    if (S = '') or IsParam(S) then begin
      if GetParam(S, 'Q') then begin
        Quiet := True;
        ShowProgress := CompareText(S, 'P') = 0;
      end
      else if GetParam(S, 'O') then begin
        if S = '-' then Output := 'no'
        else if S = '+' then Output := 'yes'
        else OutputPath := S;
      end
      else if GetParam(S, 'F') then
        OutputFilename := S
      else if GetParam(S, 'S') then begin
        if Pos('=', S) = 0 then begin
          ShowBanner;
          WriteStdErr('Invalid option: ' + S);
          Halt(1);
        end;
        SignTools.Add(S);
      end else if IsppMode and GetParam(S, 'D') then begin
        Definitions := Definitions + S + #1;
      end
      else if IsppMode and GetParam(S, 'I') then begin
        IncludePath := IncludePath + ';' + S;
      end
      else if IsppMode and GetParam(S, 'J') then begin
        IncludeFiles := IncludeFiles + S + #1;
      end
      else if IsppMode and GetParam(S, '{#') then begin
        if S <> '' then IsppOptions.InlineStart := AnsiString(S);
      end
      else if IsppMode and GetParam(S, '}') then begin
        if S <> '' then IsppOptions.InlineEnd := AnsiString(S);
      end
      else if IsppMode and GetParam(S, 'V') then begin
        if S <> '' then IsppOptions.VerboseLevel := StrToIntDef(S, 0);
      end
      else if IsppMode and (GetParam(S, '$') or GetParam(S, 'P')) then begin
        { Already handled above }
      end
      else if S = '/?' then begin
        ShowBanner;
        ShowUsage;
        Halt(1);
      end
      else begin
        ShowBanner;
        WriteStdErr('Unknown option: ' + S);
        Halt(1);
      end;
    end
    else begin
      { Not a switch; must be the script filename }
      if ScriptFilename <> '' then begin
        ShowBanner;
        WriteStdErr('You may not specify more than one script filename.');
        Halt(1);
      end;
      ScriptFilename := S;
    end;
  end;

  if ScriptFilename = '' then begin
    ShowBanner;
    ShowUsage;
    Halt(1);
  end;

  if not Quiet then
    ShowBanner;
end;

procedure Go;

  procedure AppendOption(var Opts: String; const OptName, OptValue: String);
  begin
    Opts := Opts + OptName + '=' + OptValue + #0;
  end;

  function ConvertOptionsToString(const Options: TOptions): String;
  var
    I: TOptionID;
  begin
    Result := '';
    for I := 0 to 25 do
      if I in Options then
        Result := Result + Chr(Ord('a') + I);
  end;

  procedure IsppOptionsToString(var S: String; Opt: TIsppOptions; Definitions, IncludePath, IncludeFiles: String);
  begin
    with Opt do begin
      AppendOption(S, 'ISPP:ParserOptions', ConvertOptionsToString(ParserOptions));
      AppendOption(S, 'ISPP:Options', ConvertOptionsToString(Options));
      AppendOption(S, 'ISPP:VerboseLevel', IntToStr(VerboseLevel));
      AppendOption(S, 'ISPP:InlineStart', String(InlineStart));
      AppendOption(S, 'ISPP:InlineEnd', String(InlineEnd));
    end;

    AppendOption(S, 'ISPP:Definitions', Definitions);
    AppendOption(S, 'ISPP:IncludePath', IncludePath);
    AppendOption(S, 'ISPP:IncludeFiles', IncludeFiles);
  end;

var
  ScriptPath: String;
  ExitCode: Integer;
  Ver: PCompilerVersionInfo;
  F: TTextFileReader;
  Params: TCompileScriptParamsEx;
  Options: String;
  Res: Integer;
  I: Integer;
  IDESignTools: TStringList;
begin
  if ScriptFilename <> '-' then begin
    ScriptFilename := PathExpand(ScriptFilename);
    ScriptPath := PathExtractPath(ScriptFilename);
  end
  else begin
    { Read from standard input }
    ScriptFilename := '<stdin>';
    ScriptPath := GetCurrentDir;
  end;

  {$IFNDEF STATICCOMPILER}
  Ver := ISDllGetVersion;
  {$ELSE}
  Ver := ISGetVersion;
  {$ENDIF}
  if Ver.BinVersion < $05000500 then begin
    { 5.0.5 or later is required since we use TCompileScriptParamsEx }
    WriteStdErr('Incompatible compiler engine version.');
    Halt(1);
  end;

  ProgressPoint.X := -1;
  ExitCode := 0;
  try
    if ScriptFilename <> '<stdin>' then
      F := TTextFileReader.Create(ScriptFilename, fdOpenExisting, faRead, fsRead)
    else
      F := TTextFileReader.CreateWithExistingHandle(GetStdHandle(STD_INPUT_HANDLE));
    try
      ReadScriptLines(F);
    finally
      F.Free;
    end;

    if not Quiet then begin
      WriteStdOut('Compiler engine version: ' + String(Ver.Title) + ' ' + String(Ver.Version));
      WriteStdOut('');
    end;

    FillChar(Params, SizeOf(Params), 0);
    Params.Size := SizeOf(Params);
    Params.SourcePath := PChar(ScriptPath);
    Params.CallbackProc := CompilerCallbackProc;
    Options := '';
    if Output <> '' then
      AppendOption(Options, 'Output', Output);
    if OutputPath <> '' then
      AppendOption(Options, 'OutputDir', OutputPath);
    if OutputFilename <> '' then
      AppendOption(Options, 'OutputBaseFilename', OutputFilename);

    for I := 0 to SignTools.Count-1 do
      Options := Options + AddSignToolParam(SignTools[I]);

    IDESignTools := TStringList.Create;
    try
      { Also automatically read and add SignTools defined using the IDE. Adding
        these after the command line SignTools so that the latter are always
        found first by the compiler. }
      ReadSignTools(IDESignTools);
      for I := 0 to IDESignTools.Count-1 do
        Options := Options + AddSignToolParam(IDESignTools[I]);
    finally
      IDESignTools.Free;
    end;

    if IsppMode then
      IsppOptionsToString(Options, IsppOptions, Definitions, IncludePath, IncludeFiles);

    Params.Options := PChar(Options);

    StartTime := GetTickCount;
    {$IFNDEF STATICCOMPILER}
    Res := ISDllCompileScript(Params);
    {$ELSE}
    Res := ISCompileScript(Params, False);
    {$ENDIF}
    case Res of
      isceNoError: ;
      isceCompileFailure: begin
          ExitCode := 2;
          WriteStdErr('Compile aborted.');
        end;
    else
      ExitCode := 1;
      WriteStdErr(Format('Internal error: ISDllCompileScript returned ' +
        'unexpected result (%d).', [Res]));
    end;
  finally
    FreeScriptLines;
  end;
  if ExitCode <> 0 then
    Halt(ExitCode);
end;

begin
  SignTools := TStringList.Create;
  try
    StdOutHandle := GetStdHandle(STD_OUTPUT_HANDLE);
    StdErrHandle := GetStdHandle(STD_ERROR_HANDLE);
    SetConsoleCtrlHandler(@ConsoleCtrlHandler, True);
    try
      IsppMode := FileExists(ExtractFilePath(NewParamStr(0)) + 'ispp.dll');
      ProcessCommandLine;
      Go;
    except
      { Show a friendlier exception message. (By default, Delphi prints out
        the exception class and address.) }
      WriteStdErr(GetExceptMessage);
      Halt(2);
    end;
  finally
    SignTools.Free;
  end;
end.