362 lines
10 KiB
ObjectPascal
362 lines
10 KiB
ObjectPascal
{
|
|
********************************************************************************
|
|
|
|
SPackGui
|
|
Copyright (C) 2012-2013 Geoffray Levasseur <geoffray.levasseurbrandin@numericable.fr>.
|
|
Copyright (C) <date> <add your name and mail address here>
|
|
|
|
http://www.geoffray-levasseur.org/
|
|
http://0.tuxfamilly.org/
|
|
|
|
This software is governed by the CeCILL license under French law and
|
|
abiding by the rules of distribution of free software. You can use,
|
|
modify and/ or redistribute the software under the terms of the CeCILL
|
|
license as circulated by CEA, CNRS and INRIA at the following URL
|
|
"http://www.cecill.info".
|
|
|
|
As a counterpart to the access to the source code and rights to copy,
|
|
modify and redistribute granted by the license, users are provided only
|
|
with a limited warranty and the software's author, the holder of the
|
|
economic rights, and the successive licensors have only limited
|
|
liability.
|
|
|
|
In this respect, the user's attention is drawn to the risks associated
|
|
with loading, using, modifying and/or developing or reproducing the
|
|
software by the user in light of its specific status of free software,
|
|
that may mean that it is complicated to manipulate, and that also
|
|
therefore means that it is reserved for developers and experienced
|
|
professionals having in-depth computer knowledge. Users are therefore
|
|
encouraged to load and test the software's suitability as regards their
|
|
requirements in conditions enabling the security of their systems and/or
|
|
data to be ensured and, more generally, to use and operate it in the
|
|
same conditions as regards security.
|
|
|
|
The fact that you are presently reading this means that you have had
|
|
knowledge of the CeCILL license and that you accept its terms.
|
|
|
|
********************************************************************************
|
|
|
|
Description:
|
|
Base SPack functions
|
|
|
|
********************************************************************************
|
|
}
|
|
unit uSpackPackage;
|
|
|
|
{$include defines.inc}
|
|
|
|
interface
|
|
|
|
uses
|
|
Classes, SysUtils;
|
|
|
|
const
|
|
MaxPackAlt = 16;
|
|
|
|
type
|
|
TPkgState = set of (psInstalled, psAvailable, psUpdatable, psDeprecated);
|
|
TSourceType = (srtNone, srtLocal, srtHTTP, srtFTP);
|
|
|
|
TPackageProperties = record
|
|
Version: string;
|
|
Build: Byte;
|
|
Size: LongInt; //due to spack limitation all the sizes are in Ko
|
|
SourceType: TSourceType;
|
|
SourceAddress: string;
|
|
Installed: Boolean;
|
|
end;
|
|
|
|
TPackageAlternatives = array[1..MaxPackAlt] of TPackageProperties;
|
|
|
|
TSPackPackage = class(TObject)
|
|
public
|
|
Name: string;
|
|
Desc: string;
|
|
State: TPkgState;
|
|
InstSize: LongInt;
|
|
Cat: string;
|
|
FileList: Boolean;
|
|
Alternatives: TPackageAlternatives;
|
|
constructor Create;
|
|
destructor Destroy; override;
|
|
function AddNewSource(const Ver: string; const Bld: Byte;
|
|
const Sz: LongInt; const SrcType: TSourceType;
|
|
const SrcAddr: string): Integer;
|
|
procedure ReadInstalledPackage(const S: string);
|
|
procedure ReadPackageFile(const Repo, FileName: string);
|
|
procedure ReadDistRepoPackage(const Repo, S: string);
|
|
function LoadFileList(InstDir: string): TStringList;
|
|
function GetInstalled: Byte;
|
|
function GetDefaultVer: Byte;
|
|
function GetLatest: Byte;
|
|
end;
|
|
|
|
|
|
implementation
|
|
|
|
uses
|
|
uStrings, uCommon, uUtils, uDebug, FileUtil;
|
|
|
|
constructor TSPackPackage.Create;
|
|
var
|
|
I: Integer;
|
|
begin
|
|
Name := '';
|
|
Desc := '';
|
|
State := [];
|
|
Cat := '';
|
|
InstSize := 0;
|
|
for I := 1 to MaxPackAlt do
|
|
begin
|
|
Alternatives[I].Version := '';
|
|
Alternatives[I].Build := 0;
|
|
Alternatives[I].SourceType := srtNone;
|
|
Alternatives[I].SourceAddress := '';
|
|
Alternatives[I].Size := 0;
|
|
Alternatives[I].Installed := False;
|
|
end;
|
|
FileList := False;
|
|
end;
|
|
|
|
|
|
destructor TSPackPackage.Destroy;
|
|
begin
|
|
//for now, nothing to destroy
|
|
end;
|
|
|
|
|
|
function TSPackPackage.AddNewSource(const Ver: string; const Bld: Byte;
|
|
const Sz: LongInt; const SrcType: TSourceType;
|
|
const SrcAddr: string): Integer;
|
|
var
|
|
I: Byte;
|
|
begin
|
|
if Trim(Ver) = '' then
|
|
raise Exception.Create(rsExceptEmptyVersion);
|
|
I := 1;
|
|
while Alternatives[I].Version <> '' do
|
|
if I <= MaxPackAlt then
|
|
Inc(I)
|
|
else
|
|
raise Exception.Create(rsExceptMaxPackageAlt);
|
|
Alternatives[I].Version := Ver;
|
|
Alternatives[I].Build := Bld;
|
|
Alternatives[I].Size := Sz;
|
|
Alternatives[I].SourceType := SrcType;
|
|
Alternatives[I].SourceAddress := SrcAddr;
|
|
// the following works only if installed packages are loaded first
|
|
if GetInstalled <> 0 then
|
|
if (SrcAddr = GetRepoAddress(sDefaultRepo)) and
|
|
((Ver <> Alternatives[GetInstalled].Version) or
|
|
(Bld <> Alternatives[GetInstalled].Build)) then
|
|
State := State + [psUpdatable];
|
|
Result := I;
|
|
end;
|
|
|
|
|
|
procedure TSPackPackage.ReadInstalledPackage(const S: string);
|
|
const
|
|
Sep = ':';
|
|
var
|
|
Txt: Text;
|
|
Tmp: string;
|
|
I, ASize: Integer;
|
|
ABuild: Byte;
|
|
Arch, AName, AVersion, ASourceAddress: string;
|
|
ASourceType: TSourceType;
|
|
begin
|
|
if not FileExists(S) then
|
|
Exit;
|
|
AssignFile(Txt, S);
|
|
{$I-}
|
|
Reset(Txt);
|
|
{$I+}
|
|
try
|
|
//first line is package name, with version and arch
|
|
Readln(Txt, Tmp);
|
|
I := Pos(Sep, Tmp) + 2; // + 1 for the space after
|
|
DecomposePackageName(Copy(Tmp, I, Length(Tmp) - I + 1),
|
|
AName, AVersion, ABuild, Arch);
|
|
if Name = '' then
|
|
Name := AName;
|
|
//second line is compressed size (we convert in Byte)
|
|
Readln(Txt, Tmp);
|
|
I := Pos(Sep, Tmp) + 2;
|
|
ASize := StrToInt(Copy(Tmp, I, Length(Tmp) - I)) * 1024;
|
|
//third line is uncompressed size
|
|
Readln(Txt, Tmp);
|
|
I := Pos(Sep, Tmp) + 2;
|
|
InstSize := StrToInt(Copy(Tmp, I, Length(Tmp) - I )) * 1024;
|
|
//fourth line is the full path of the spack file (may not be in a repository)
|
|
Readln(Txt, Tmp);
|
|
I := Pos(Sep, Tmp) + 2;
|
|
ASourceAddress := Copy(Tmp, I, Length(Tmp) - I + 1);
|
|
if FileExists(ASourceAddress) then
|
|
ASourceType := srtLocal
|
|
else
|
|
ASourceType := srtNone;
|
|
//fifth line marks the beginning of package description
|
|
Readln(Txt, Tmp);
|
|
Readln(Txt, Tmp);
|
|
I := Pos('(', Tmp) + 1;
|
|
Desc := Copy(Tmp, I, Length(Tmp) - I);
|
|
//seventh line mark the beginning of filelist (just say it's available)
|
|
FileList := True;
|
|
State := State + [psInstalled];
|
|
I := AddNewSource(AVersion, ABuild, ASize, ASourceType, ASourceAddress);
|
|
Alternatives[I].Installed := True;
|
|
CloseFile(Txt);
|
|
except
|
|
PrintLnDbg(Format(rsErrorLoadingPackage, [S]), vlLow);
|
|
try
|
|
CloseFile(Txt);
|
|
finally
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
|
|
procedure TSPackPackage.ReadPackageFile(const Repo, FileName: string);
|
|
var
|
|
Arch: string;
|
|
ASourceType: TSourceType;
|
|
AName, AVersion, ASourceAddress: string;
|
|
ABuild: Byte;
|
|
ASize: Longint;
|
|
begin
|
|
if (Pos(sHttpPrefix, Repo) = 1) then
|
|
ASourceType := srtHTTP
|
|
else
|
|
if (Pos(sFtpPrefix, Repo) = 1) then
|
|
ASourceType := srtFTP
|
|
else
|
|
ASourceType := srtLocal;
|
|
DecomposePackageName(Copy(ExtractFileName(FileName), 1,
|
|
Length(ExtractFileName(FileName)) - Length(ExtractFileExt(FileName))),
|
|
AName, AVersion, ABuild, Arch);
|
|
Cat := Copy(ExtractFilePath(FileName), Length(Repo),
|
|
Length(ExtractFilePath(FileName)) - Length(Repo));
|
|
if Cat[1] = '/' then
|
|
Cat := Copy(Cat, 2, Length(Cat) - 1);
|
|
if Cat[Length(Cat)] = '/' then
|
|
Cat := Copy(Cat, 1, Length(Cat) - 1);
|
|
if bUnitsAreDecimal then
|
|
ASize := FileSize(FileName)
|
|
else
|
|
ASize := FileSize(FileName);
|
|
ASourceAddress := Repo;
|
|
FileList := Filelist or False;
|
|
if Name = '' then
|
|
Name := AName;
|
|
if (Name <> AName) then
|
|
raise Exception.Create(rsExceptPackageNameMismatch);
|
|
AddNewSource(AVersion, ABuild, ASize, ASourceType, ASourceAddress);
|
|
end;
|
|
|
|
|
|
procedure TSPackPackage.ReadDistRepoPackage(const Repo, S: string);
|
|
var
|
|
P: Integer;
|
|
Tmp, Name2, Arch: string;
|
|
AName, AVersion, ASourceAddress: string;
|
|
ASourceType: TSourceType;
|
|
ABuild: Byte;
|
|
begin
|
|
ASourceAddress := Copy(Repo, Pos('=', Repo) + 1, Length(Repo) - Pos('=', Repo));
|
|
if (Pos(sHttpPrefix, Repo) = 1) then
|
|
ASourceType := srtHTTP
|
|
else
|
|
if (Pos(sFtpPrefix, Repo) = 1) then
|
|
ASourceType := srtFTP
|
|
else
|
|
ASourceType := srtLocal;
|
|
P := Pos(' ', S);
|
|
Name2 := Copy(S, 1, P - 1);
|
|
Tmp := Copy(S, P + 1, Length(S) - P);
|
|
P := Pos(' ', Tmp);
|
|
//if you uncomment the following you'll get huge log files
|
|
//PrintLnDbg('D Adding package ' + Copy(Tmp, 1, P - 1) + ' (' + Name +
|
|
// ') from ' + Repo + '...');
|
|
DecomposePackageName(Copy(Tmp, 1, P - 1), AName, AVersion, ABuild, Arch);
|
|
if Name = '' then
|
|
Name := AName;
|
|
Cat := Copy(Tmp, P + 1, Length(Tmp) - P - 1);
|
|
if (AName <> Name2) or ((Name <> '') and (Name <> AName)) then
|
|
raise Exception.Create(rsExceptPackageNameMismatch);
|
|
AddNewSource(AVersion, ABuild, 0, ASourceType, ASourceAddress);
|
|
FileList := Filelist or False;
|
|
end;
|
|
|
|
|
|
function TSPackPackage.LoadFileList(InstDir: string): TStringList;
|
|
var
|
|
T: Text;
|
|
I: Integer;
|
|
Tmp, FName: string;
|
|
begin
|
|
Result := TStringList.Create;
|
|
if FileList then
|
|
begin
|
|
I := GetInstalled;
|
|
FName := InstDir + '/' + Name + '-' + Alternatives[I].Version + '-' +
|
|
sArch + '-' + IntToStr(Alternatives[I].Build);
|
|
PrintLnDbg(Format(rsInfoGetFileList, [FName]));
|
|
if FileExists(FName) then
|
|
begin
|
|
AssignFile(T, FName);
|
|
Reset(T);
|
|
//we don't care the 8 first lines
|
|
for I := 0 to 8 do
|
|
Readln(T, Tmp);
|
|
while not EOF(T) do
|
|
begin
|
|
Readln(T, Tmp);
|
|
Result.Add(Tmp);
|
|
end;
|
|
end;
|
|
end else
|
|
PrintLnDbg(rsWarningNoFileList, vlLow);
|
|
end;
|
|
|
|
|
|
function TSPackPackage.GetInstalled: Byte;
|
|
var
|
|
I: Integer;
|
|
begin
|
|
Result := 0;
|
|
for I := 1 to MaxPackAlt do
|
|
if Alternatives[I].Installed then
|
|
Result := I;
|
|
end;
|
|
|
|
function TSPackPackage.GetDefaultVer: Byte;
|
|
var
|
|
I: Integer;
|
|
begin
|
|
Result := 0;
|
|
for I := 1 to MaxPackAlt do
|
|
if (Alternatives[I].Version <> '') and
|
|
(GetRepoAddress(sDefaultRepo) = Alternatives[I].SourceAddress) then
|
|
Result := I;
|
|
end;
|
|
|
|
function TSPackPackage.GetLatest: Byte;
|
|
var
|
|
I: Integer;
|
|
begin
|
|
Result := 1;
|
|
for I := 2 to MaxPackAlt do
|
|
if Alternatives[I].Version <> '' then
|
|
if CompareVersion(Alternatives[I].Version,
|
|
Alternatives[Result].Version) >= 1 then
|
|
Result := I
|
|
else
|
|
if (CompareVersion(Alternatives[Result].Version,
|
|
Alternatives[I].Version) = 0) and
|
|
(Alternatives[Result].Build < Alternatives[I].Build) then
|
|
Result := I;
|
|
end;
|
|
|
|
end.
|
|
|