Files
0linux/common/uspackpackage.pas
2023-10-06 15:59:41 +02:00

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.