429 lines
12 KiB
ObjectPascal
429 lines
12 KiB
ObjectPascal
unit Shared.SetupTypes;
|
|
|
|
{
|
|
Inno Setup
|
|
Copyright (C) 1997-2025 Jordan Russell
|
|
Portions by Martijn Laan
|
|
For conditions of distribution and use, see LICENSE.TXT.
|
|
|
|
Types and functions used by both ISCmplr-only and Setup-only units
|
|
}
|
|
|
|
interface
|
|
|
|
uses
|
|
SysUtils, Classes, ECDSA, Shared.Struct;
|
|
|
|
const
|
|
{ Predefined page identifiers }
|
|
wpWelcome = 1;
|
|
wpLicense = 2;
|
|
wpPassword = 3;
|
|
wpInfoBefore = 4;
|
|
wpUserInfo = 5;
|
|
wpSelectDir = 6;
|
|
wpSelectComponents = 7;
|
|
wpSelectProgramGroup = 8;
|
|
wpSelectTasks = 9;
|
|
wpReady = 10;
|
|
wpPreparing = 11;
|
|
wpInstalling = 12;
|
|
wpInfoAfter = 13;
|
|
wpFinished = 14;
|
|
|
|
type
|
|
TInstallOnThisVersionResult = (irInstall, irNotOnThisPlatform,
|
|
irVersionTooLow, irServicePackTooLow, irVerTooHigh);
|
|
|
|
TRenamedConstantCallBack = procedure(const Cnst, CnstRenamed: String) of object;
|
|
|
|
TArrayOfECDSAKey = array of TECDSAKey;
|
|
|
|
TVerificationError = (veSignatureMissing, veSignatureMalformed, veKeyNotFound,
|
|
veSignatureBad, veFileSizeIncorrect, veFileHashIncorrect);
|
|
|
|
const
|
|
crHand = 1;
|
|
|
|
CodeRootKeyFlagMask = $7F000000;
|
|
CodeRootKeyFlag32Bit = $01000000;
|
|
CodeRootKeyFlag64Bit = $02000000;
|
|
CodeRootKeyValidFlags = CodeRootKeyFlag32Bit or CodeRootKeyFlag64Bit;
|
|
|
|
HKEY_AUTO = 1; { Any value will work as long as it isn't 0 and doesn't match a predefined key handle (8xxxxxxx) nor includes any of the CodeRootKeyValidFlags flags. }
|
|
|
|
function StringsToCommaString(const Strings: TStrings): String;
|
|
procedure SetStringsFromCommaString(const Strings: TStrings; const Value: String);
|
|
function StrToSetupVersionData(const S: String; var VerData: TSetupVersionData): Boolean;
|
|
procedure HandleRenamedConstants(var Cnst: String; const RenamedConstantCallback: TRenamedConstantCallback);
|
|
procedure GenerateEncryptionKey(const Password: String; const Salt: TSetupKDFSalt;
|
|
const Iterations: Integer; out Key: TSetupEncryptionKey);
|
|
procedure SetISSigAllowedKey(var ISSigAllowedKeys: AnsiString; const KeyIndex: Integer);
|
|
function GetISSigAllowedKeys([ref] const ISSigAvailableKeys: TArrayOfECDSAKey;
|
|
const ISSigAllowedKeys: AnsiString): TArrayOfECDSAKey;
|
|
function IsExcluded(Text: String; const AExcludes: TStrings): Boolean;
|
|
|
|
implementation
|
|
|
|
uses
|
|
PBKDF2, PathFunc, Shared.CommonFunc;
|
|
|
|
function QuoteStringIfNeeded(const S: String): String;
|
|
{ Used internally by StringsToCommaString. Adds quotes around the string if
|
|
needed, and doubles any embedded quote characters.
|
|
Note: No lead byte checking is done since spaces/commas/quotes aren't used
|
|
as trail bytes in any of the Far East code pages (CJK). }
|
|
var
|
|
Len, QuoteCount, I: Integer;
|
|
HasSpecialChars: Boolean;
|
|
P: PChar;
|
|
begin
|
|
Len := Length(S);
|
|
HasSpecialChars := False;
|
|
QuoteCount := 0;
|
|
for I := 1 to Len do begin
|
|
case S[I] of
|
|
#0..' ', ',': HasSpecialChars := True;
|
|
'"': Inc(QuoteCount);
|
|
end;
|
|
end;
|
|
if not HasSpecialChars and (QuoteCount = 0) then begin
|
|
Result := S;
|
|
Exit;
|
|
end;
|
|
|
|
SetString(Result, nil, Len + QuoteCount + 2);
|
|
P := Pointer(Result);
|
|
P^ := '"';
|
|
Inc(P);
|
|
for I := 1 to Len do begin
|
|
if S[I] = '"' then begin
|
|
P^ := '"';
|
|
Inc(P);
|
|
end;
|
|
P^ := S[I];
|
|
Inc(P);
|
|
end;
|
|
P^ := '"';
|
|
end;
|
|
|
|
function StringsToCommaString(const Strings: TStrings): String;
|
|
{ Creates a comma-delimited string from Strings.
|
|
Note: Unlike Delphi 2's TStringList.CommaText property, this function can
|
|
handle an unlimited number of characters. }
|
|
var
|
|
I: Integer;
|
|
S: String;
|
|
begin
|
|
if (Strings.Count = 1) and (Strings[0] = '') then
|
|
Result := '""'
|
|
else begin
|
|
Result := '';
|
|
for I := 0 to Strings.Count-1 do begin
|
|
S := QuoteStringIfNeeded(Strings[I]);
|
|
if I = 0 then
|
|
Result := S
|
|
else
|
|
Result := Result + ',' + S;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
procedure SetStringsFromCommaString(const Strings: TStrings; const Value: String);
|
|
{ Replaces Strings with strings from the comma- or space-delimited Value.
|
|
Note: No lead byte checking is done since spaces/commas/quotes aren't used
|
|
as trail bytes in any of the Far East code pages (CJK).
|
|
Also, this isn't bugged like Delphi 3+'s TStringList.CommaText property --
|
|
SetStringsFromCommaString(..., 'a,') will add two items, not one. }
|
|
var
|
|
P, PStart, PDest: PChar;
|
|
CharCount: Integer;
|
|
S: String;
|
|
begin
|
|
Strings.BeginUpdate;
|
|
try
|
|
Strings.Clear;
|
|
P := PChar(Value);
|
|
while CharInSet(P^, [#1..' ']) do
|
|
Inc(P);
|
|
if P^ <> #0 then begin
|
|
while True do begin
|
|
if P^ = '"' then begin
|
|
Inc(P);
|
|
PStart := P;
|
|
CharCount := 0;
|
|
while P^ <> #0 do begin
|
|
if P^ = '"' then begin
|
|
Inc(P);
|
|
if P^ <> '"' then Break;
|
|
end;
|
|
Inc(CharCount);
|
|
Inc(P);
|
|
end;
|
|
P := PStart;
|
|
SetString(S, nil, CharCount);
|
|
PDest := Pointer(S);
|
|
while P^ <> #0 do begin
|
|
if P^ = '"' then begin
|
|
Inc(P);
|
|
if P^ <> '"' then Break;
|
|
end;
|
|
PDest^ := P^;
|
|
Inc(P);
|
|
Inc(PDest);
|
|
end;
|
|
end
|
|
else begin
|
|
PStart := P;
|
|
while (P^ > ' ') and (P^ <> ',') do
|
|
Inc(P);
|
|
SetString(S, PStart, P - PStart);
|
|
end;
|
|
Strings.Add(S);
|
|
while CharInSet(P^, [#1..' ']) do
|
|
Inc(P);
|
|
if P^ = #0 then
|
|
Break;
|
|
if P^ = ',' then begin
|
|
repeat
|
|
Inc(P);
|
|
until not CharInSet(P^, [#1..' ']);
|
|
end;
|
|
end;
|
|
end;
|
|
finally
|
|
Strings.EndUpdate;
|
|
end;
|
|
end;
|
|
|
|
function StrToSetupVersionData(const S: String; var VerData: TSetupVersionData): Boolean;
|
|
|
|
procedure Split(const Str: String; var Ver: TSetupVersionDataVersion;
|
|
var ServicePack: Word);
|
|
var
|
|
I, J: Integer;
|
|
Z, B: String;
|
|
HasBuild: Boolean;
|
|
begin
|
|
Cardinal(Ver) := 0;
|
|
ServicePack := 0;
|
|
Z := Lowercase(Str);
|
|
I := Pos('sp', Z);
|
|
if I <> 0 then begin
|
|
J := StrToInt(Copy(Z, I+2, Maxint));
|
|
if (J < Low(Byte)) or (J > High(Byte)) then
|
|
Abort;
|
|
ServicePack := J shl 8;
|
|
{ ^ Shift left 8 bits because we're setting the "major" service pack
|
|
version number. This parser doesn't currently accept "minor" service
|
|
pack version numbers. }
|
|
SetLength(Z, I-1);
|
|
end;
|
|
I := Pos('.', Z);
|
|
if I = Length(Z) then Abort;
|
|
if I <> 0 then begin
|
|
J := StrToInt(Copy(Z, 1, I-1));
|
|
if (J < 0) or (J > 127) then
|
|
Abort;
|
|
Ver.Major := J;
|
|
Z := Copy(Z, I+1, Maxint);
|
|
I := Pos('.', Z);
|
|
HasBuild := I <> 0;
|
|
if not HasBuild then
|
|
I := Length(Z)+1;
|
|
B := Copy(Z, I+1, Maxint);
|
|
Z := Copy(Z, 1, I-1);
|
|
J := StrToInt(Z);
|
|
if (J < 0) or (J > 99) then Abort;
|
|
Ver.Minor := J;
|
|
if HasBuild then begin
|
|
J := StrToInt(B);
|
|
if (J < Low(Ver.Build)) or (J > High(Ver.Build)) then
|
|
Abort;
|
|
Ver.Build := J;
|
|
end;
|
|
end
|
|
else begin { no minor version specified }
|
|
J := StrToInt(Z);
|
|
if (J < 0) or (J > 127) then
|
|
Abort;
|
|
Ver.Major := J;
|
|
end;
|
|
end;
|
|
var
|
|
I: Integer;
|
|
SP: Word;
|
|
begin
|
|
try
|
|
VerData.WinVersion := 0;
|
|
I := Pos(',', S);
|
|
if I <> 0 then begin
|
|
Split(Trim(Copy(S, 1, I-1)),
|
|
TSetupVersionDataVersion(VerData.WinVersion), SP);
|
|
if SP <> 0 then Abort; { only NT has service packs }
|
|
end;
|
|
Split(Trim(Copy(S, I+1, Maxint)),
|
|
TSetupVersionDataVersion(VerData.NTVersion), VerData.NTServicePack);
|
|
Result := True;
|
|
except
|
|
if (ExceptObject is EAbort) or (ExceptObject is EConvertError) then
|
|
Result := False
|
|
else
|
|
raise;
|
|
end;
|
|
end;
|
|
|
|
procedure HandleRenamedConstants(var Cnst: String; const RenamedConstantCallback: TRenamedConstantCallback);
|
|
var
|
|
CnstRenamed: String;
|
|
begin
|
|
if Cnst = 'fonts' then
|
|
CnstRenamed := 'commonfonts'
|
|
else if Cnst = 'sendto' then
|
|
CnstRenamed := 'usersendto'
|
|
else if Cnst = 'pf' then
|
|
CnstRenamed := 'commonpf'
|
|
else if Cnst = 'pf32' then
|
|
CnstRenamed := 'commonpf32'
|
|
else if Cnst = 'pf64' then
|
|
CnstRenamed := 'commonpf64'
|
|
else if Cnst = 'cf' then
|
|
CnstRenamed := 'commoncf'
|
|
else if Cnst = 'cf32' then
|
|
CnstRenamed := 'commoncf32'
|
|
else if Cnst = 'cf64' then
|
|
CnstRenamed := 'commoncf64'
|
|
else
|
|
CnstRenamed := '';
|
|
|
|
if CnstRenamed <> '' then begin
|
|
if Assigned(RenamedConstantCallback) then
|
|
RenamedConstantCallback(Cnst, CnstRenamed);
|
|
Cnst := CnstRenamed;
|
|
end;
|
|
end;
|
|
|
|
procedure GenerateEncryptionKey(const Password: String; const Salt: TSetupKDFSalt;
|
|
const Iterations: Integer; out Key: TSetupEncryptionKey);
|
|
begin
|
|
var SaltBytes: TBytes;
|
|
var SaltSize := SizeOf(Salt);
|
|
SetLength(SaltBytes, SaltSize);
|
|
Move(Salt[0], SaltBytes[0], SaltSize);
|
|
var KeyLength := SizeOf(Key);
|
|
var KeyBytes := PBKDF2SHA256(Password, SaltBytes, Iterations, KeyLength);
|
|
Move(KeyBytes[0], Key[0], KeyLength);
|
|
end;
|
|
|
|
procedure SetISSigAllowedKey(var ISSigAllowedKeys: AnsiString; const KeyIndex: Integer);
|
|
{ ISSigAllowedKeys should start out empty. If you then only use this function
|
|
to update it, regular string comparison can be used for comparisons. }
|
|
begin
|
|
const ByteIndex = KeyIndex div 8;
|
|
while ByteIndex >= Length(ISSigAllowedKeys) do
|
|
ISSigAllowedKeys := ISSigAllowedKeys + #0;
|
|
const BitIndex = KeyIndex mod 8;
|
|
ISSigAllowedKeys[ByteIndex+1] := AnsiChar(Byte(ISSigAllowedKeys[ByteIndex+1]) or (1 shl BitIndex));
|
|
end;
|
|
|
|
function IsISSigAllowedKey(const ISSigAllowedKeys: AnsiString; const KeyIndex: Integer): Boolean;
|
|
begin
|
|
const ByteIndex = KeyIndex div 8;
|
|
if ByteIndex >= Length(ISSigAllowedKeys) then
|
|
Exit(False);
|
|
const BitIndex = KeyIndex mod 8;
|
|
Result := Byte(ISSigAllowedKeys[ByteIndex+1]) and (1 shl BitIndex) <> 0;
|
|
end;
|
|
|
|
function GetISSigAllowedKeys([ref] const ISSigAvailableKeys: TArrayOfECDSAKey;
|
|
const ISSigAllowedKeys: AnsiString): TArrayOfECDSAKey;
|
|
{ Returns all keys if ISSigAllowedKeys is empty! }
|
|
begin
|
|
if ISSigAllowedKeys <> '' then begin
|
|
const NAvailable = Length(ISSigAvailableKeys);
|
|
SetLength(Result, NAvailable);
|
|
var NAdded := 0;
|
|
for var KeyIndex := 0 to NAvailable-1 do begin
|
|
if IsISSigAllowedKey(ISSigAllowedKeys, KeyIndex) then begin
|
|
Result[NAdded] := ISSigAvailableKeys[KeyIndex];
|
|
Inc(NAdded);
|
|
end;
|
|
end;
|
|
SetLength(Result, NAdded);
|
|
end else
|
|
Result := ISSigAvailableKeys;
|
|
end;
|
|
|
|
function IsExcluded(Text: String; const AExcludes: TStrings): Boolean;
|
|
|
|
function CountBackslashes(S: PChar): Integer;
|
|
begin
|
|
Result := 0;
|
|
while True do begin
|
|
S := PathStrScan(S, '\');
|
|
if S = nil then
|
|
Break;
|
|
Inc(Result);
|
|
Inc(S);
|
|
end;
|
|
end;
|
|
|
|
begin
|
|
if AExcludes.Count > 0 then begin
|
|
Text := PathLowercase(Text);
|
|
UniqueString(Text);
|
|
const T = PChar(Text);
|
|
const TB = CountBackslashes(T);
|
|
|
|
for var AExclude in AExcludes do begin
|
|
var P := PChar(AExclude);
|
|
|
|
{ Leading backslash in an exclude pattern means 'match at the front
|
|
instead of the end' }
|
|
var MatchFront := False;
|
|
if P^ = '\' then begin
|
|
MatchFront := True;
|
|
Inc(P);
|
|
end;
|
|
|
|
const PB = CountBackslashes(P);
|
|
{ The text must contain at least as many backslashes as the pattern
|
|
for a match to be possible }
|
|
if TB >= PB then begin
|
|
var TStart := T;
|
|
var TEnd: PChar;
|
|
if not MatchFront then begin
|
|
{ If matching at the end, advance TStart so that TStart and P point
|
|
to the same number of components }
|
|
for var I := 1 to TB - PB do
|
|
TStart := PathStrScan(TStart, '\') + 1;
|
|
TEnd := nil;
|
|
end
|
|
else begin
|
|
{ If matching at the front, clip T to the same number of
|
|
components as P }
|
|
TEnd := T;
|
|
for var J := 1 to PB do
|
|
TEnd := PathStrScan(TEnd, '\') + 1;
|
|
TEnd := PathStrScan(TEnd, '\');
|
|
if Assigned(TEnd) then
|
|
TEnd^ := #0;
|
|
end;
|
|
|
|
if WildcardMatch(TStart, P) then begin
|
|
Result := True;
|
|
Exit;
|
|
end;
|
|
|
|
{ Put back any backslash that was temporarily null'ed }
|
|
if Assigned(TEnd) then
|
|
TEnd^ := '\';
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
Result := False;
|
|
end;
|
|
|
|
end.
|