+ lpt: Repositories sind abstrakte Klassen + lpt: HTTPRepository -- Alexander Siol alex@xxxxxxxxxx dunklermeuchler@xxxxxxxxx
diff --git a/trunk/src/modules/pas/lpt/baserepository.pas b/trunk/src/modules/pas/lpt/baserepository.pas
new file mode 100644
index 0000000..a4bfb68
--- /dev/null
+++ b/trunk/src/modules/pas/lpt/baserepository.pas
@@ -0,0 +1,49 @@
+unit baserepository;
+{$MODE ObjFPC}
+
+interface
+uses sysutils, classes, tar, packages, helpers;
+
+type
+ TRepository = class(TCollectionItem)
+ public
+ name: String;
+ url: String;
+ repostype: String;
+
+ constructor create(parent : TCollection);
+ function Download(version: TPackageVersion): TTarArchive; virtual;
+ function PrepareLists: boolean; virtual;
+ function FetchLists(pkgset: TPackageSet): boolean; virtual;
+ end;
+
+implementation
+
+constructor TRepository.create(parent: TCollection);
+begin
+ inherited;
+ repostype := 'undefined';
+end;
+
+function TRepository.Download(version: TPackageVersion): TTarArchive;
+begin
+ WriteLn('ACHTUNG - Download auf unspezifiziertem Repository!');
+ exit(nil);
+end;
+
+function TRepository.PrepareLists: boolean;
+var
+ pkglisturl: String;
+begin
+ WriteLn('ACHTUNG - PrepareLists auf unspezifiziertem Repository!');
+ exit(false);
+end;
+
+function TRepository.FetchLists(pkgset: TPackageSet): boolean;
+begin
+ WriteLn('ACHTUNG - FetchLists auf unspezifiziertem Repository!');
+ exit(false);
+end;
+
+begin
+end.
diff --git a/trunk/src/modules/pas/lpt/helpers.pas b/trunk/src/modules/pas/lpt/helpers.pas
new file mode 100644
index 0000000..91c09d4
--- /dev/null
+++ b/trunk/src/modules/pas/lpt/helpers.pas
@@ -0,0 +1,242 @@
+unit helpers;
+{$MODE ObjFPC}
+
+interface
+uses crt, sysutils, dos, classes, tar, packages, tcpip, http;
+
+procedure ScanFile(pkgset: TPackageSet; filename, repository: String);
+procedure DrawProgress(http: HTTPRequest);
+function DownloadURI(url, filename: String): boolean;
+function DownloadURI(url: String): TTarArchive;
+function getConfigRoot: String;
+procedure Untar(tarfile: String; targetpath: String = 'file:/');
+procedure Untar(tar: TTarArchive; targetpath: String = 'file:/');
+function getArch: String;
+procedure mkpath(path: string);
+
+implementation
+
+procedure mkpath(path: string);
+var
+ i: integer;
+ prefix: String;
+begin
+ i := 1;
+ while i <= length(path) do begin
+ if path[i] = '/' then begin
+ prefix := Copy(path, 1, i);
+ if not FileExists(prefix) then begin
+ mkdir(prefix);
+ end;
+ end;
+ Inc(i);
+ end;
+end;
+
+function getConfigRoot: String;
+begin
+ exit('file:/config/lpt/');
+end;
+
+function getArch: String;
+begin
+ exit('i386');
+end;
+
+procedure DrawProgress(http: HTTPRequest);
+const
+ i: Integer = 0;
+begin
+ Inc(i);
+ if i mod 16 <> 0 then begin
+ exit;
+ end;
+
+ if http.responseRemaining >= 0 then begin
+ Write(#13, (http.responseLength - http.responseRemaining), '/', http.responseLength, ' Bytes empfangen');
+ end else begin
+ Write(#13, http.responseLength, ' Bytes empfangen');
+ end;
+end;
+
+function DownloadURI(url, filename: String): boolean;
+var
+ f: File;
+ httpc: HTTPRequest;
+ tar: TTarArchive;
+ i: integer;
+begin
+ DownloadURI := false;
+ try
+ httpc := HTTPRequest.create(url);
+ httpc.setRequestHeader('Pragma', 'no-cache');
+ httpc.setRequestHeader('Cache-Control', 'no-cache');
+ WriteLn('Herunterladen von ', url);
+ Write('Verbinde...');
+ httpc.onReadTick := @DrawProgress;
+ httpc.get;
+ WriteLn;
+
+ if httpc.statusCode <> 200 then begin
+ WriteLn('Fehler: HTTP-Statuscode ', httpc.statusCode);
+ end else begin
+ Assign(f, filename);
+ Rewrite(f, httpc.responseLength);
+ BlockWrite(f, httpc.binaryResponseBody^, 1);
+ Close(f);
+ DownloadURI := true;
+ end;
+
+ httpc.done;
+ except
+ on e: Exception do WriteLn('EXCEPTION: ', e.message);
+ end;
+end;
+
+function DownloadURI(url: String): TTarArchive;
+var
+ f: File;
+ httpc: HTTPRequest;
+ tar: TTarArchive;
+ i: integer;
+begin
+ DownloadURI := nil;
+ try
+ httpc := HTTPRequest.create(url);
+ httpc.setRequestHeader('Pragma', 'no-cache');
+ httpc.setRequestHeader('Cache-Control', 'no-cache');
+ WriteLn('Herunterladen von ', url);
+ Write('Verbinde...');
+ httpc.onReadTick := @DrawProgress;
+ httpc.get;
+ WriteLn;
+
+ if httpc.statusCode <> 200 then begin
+ WriteLn('Fehler: HTTP-Statuscode ', httpc.statusCode);
+ end else begin
+ tar := TTarArchive.create(httpc.binaryResponseBody, httpc.responseLength);
+ DownloadURI := tar;
+ end;
+
+ httpc.done;
+ except
+ on e: Exception do WriteLn('EXCEPTION: ', e.message);
+ end;
+end;
+
+procedure ScanFile(pkgset: TPackageSet; filename, repository: String);
+var
+ f: Text;
+ line: String;
+ status: integer;
+
+ pkg: TPackage;
+ section: TPackageSection;
+ version: TPackageVersion;
+begin
+ Assign(f, filename);
+ Reset(f);
+ status := 0;
+ pkg := nil;
+ try
+ while not eof(f) do begin
+ ReadLn(f, line);
+
+ if line = '' then begin
+ continue;
+ end;
+
+ case line[1] of
+ 'P':
+ begin
+ status := 1;
+ pkg := pkgset.add(Copy(line, 3, length(line)));
+ end;
+ 'D':
+ if status = 1 then begin
+ pkg.desc := Copy(line, 3, length(line));
+ end else begin
+ raise EPackageFileFormat.create(
+ 'D in status ' + IntToStr(status));
+ end;
+ 'S':
+ if status >= 1 then begin
+ status := 2;
+ section := pkg.add(Copy(line, 3, length(line)));
+ end else begin
+ raise EPackageFileFormat.create(
+ 'S in status ' + IntToStr(status));
+ end;
+ 'V':
+ if status >= 2 then begin
+ status := 3;
+ version := section.add(Copy(line, 3, length(line)));
+ version.pkg := pkg;
+ version.section := section;
+ version.repository := repository;
+ end else begin
+ raise EPackageFileFormat.create(
+ 'V in status ' + IntToStr(status));
+ end;
+ 's':
+ if status >= 3 then begin
+ version.size := StrToInt(Copy(line, 3, length(line)));
+ end else begin
+ raise EPackageFileFormat.create(
+ 's in status ' + IntToStr(status));
+ end;
+ 'd':
+ if status >= 3 then begin
+ if length(line) < 2 then begin
+ raise EPackageFileFormat.create(
+ 'Einsames d');
+ end;
+
+ version.addDependency(line[2], Copy(line, 4, length(line)));
+
+ end else begin
+ raise EPackageFileFormat.create(
+ 'd in status ' + IntToStr(status));
+ end;
+ else
+ begin
+ raise EPackageFileFormat.create(
+ 'Unbekannter Schluessel: ' + line[1]);
+ end;
+ end;
+ end;
+ finally
+ Close(f);
+ end;
+end;
+
+procedure Untar(tar: TTarArchive; targetpath: String = 'file:/');
+var
+ path: String;
+ dir, filename, ext: String;
+
+ f: file;
+begin
+ while tar.hasNext do begin
+ path := tar.NextFilename;
+ dos.FSplit(path, dir, filename, ext);
+
+ mkpath(targetpath + '/' + dir);
+
+ Assign(f, targetpath + '/' + path);
+ Rewrite(f, 1);
+ tar.ExtractFile(f);
+ Close(f);
+ end;
+end;
+
+procedure Untar(tarfile: String; targetpath: String = 'file:/');
+var
+ tar: TTarArchive;
+begin
+ tar := TTarArchive.create(tarfile);
+ Untar(tar, targetpath);
+end;
+
+begin
+end.
diff --git a/trunk/src/modules/pas/lpt/httprepository.pas b/trunk/src/modules/pas/lpt/httprepository.pas
new file mode 100644
index 0000000..b34a37a
--- /dev/null
+++ b/trunk/src/modules/pas/lpt/httprepository.pas
@@ -0,0 +1,55 @@
+unit httprepository;
+{$MODE ObjFPC}
+
+interface
+uses sysutils, classes, tar, packages, helpers, baserepository;
+
+type
+ THTTPRepository = class(TRepository)
+ public
+ constructor create(parent : TCollection);
+ function Download(version: TPackageVersion): TTarArchive; override;
+ function PrepareLists: boolean; override;
+ function FetchLists(pkgset: TPackageSet): boolean; override;
+ end;
+
+implementation
+
+constructor THTTPRepository.create(parent : TCollection);
+begin
+ inherited;
+ repostype := 'http';
+end;
+
+function THTTPRepository.Download(version: TPackageVersion): TTarArchive;
+var
+ archiveURI: String;
+begin
+ archiveURI := self.url + version.pkg.name + '-'
+ + version.section.section + '-' + version.version + '-' + getArch +
+ '.tar';
+ exit(DownloadURI(archiveURI));
+end;
+
+function THTTPRepository.PrepareLists: boolean;
+var
+ pkglisturl: String;
+begin
+ if self.url[length(self.url)] <> '/' then begin
+ pkglisturl := self.url + '/packages.' + getArch;
+ end else begin
+ pkglisturl := self.url + 'packages.' + getArch;
+ end;
+
+ WriteLn('Lade Paketliste ' + self.name + ' von ' + pkglisturl);
+ exit(DownloadURI(pkglisturl, getConfigRoot + 'pkglist.' + self.name));
+end;
+
+function THTTPRepository.FetchLists(pkgset: TPackageSet): boolean;
+begin
+ ScanFile(pkgset, getConfigRoot + 'pkglist.' + self.name, self.name);
+ exit(true);
+end;
+
+begin
+end.
diff --git a/trunk/src/modules/pas/lpt/lpt.pas b/trunk/src/modules/pas/lpt/lpt.pas
index 62e0980..e3f613d 100644
--- a/trunk/src/modules/pas/lpt/lpt.pas
+++ b/trunk/src/modules/pas/lpt/lpt.pas
@@ -1,118 +1,7 @@
program lpt;
{$MODE ObjFPC}
-uses crt, dos, sysutils, classes, tar, tcpip, http, packages, repositories;
-
-const
- configRoot: String = 'file:/config/lpt/';
- arch: String = 'i386';
-
-
-procedure mkpath(path: string);
-var
- i: integer;
- prefix: String;
-begin
- //WriteLn('mkpath ' + path);
- i := 1;
- while i <= length(path) do begin
- if path[i] = '/' then begin
- //Write('> ');
- prefix := Copy(path, 1, i);
- if not FileExists(prefix) then begin
- //WriteLn('mkdir ''', prefix, '''');
- mkdir(prefix);
- end else begin;
- //WriteLn(prefix);
- end;
- end;
- Inc(i);
- end;
-end;
-
-procedure Untar(tar: TTarArchive; targetpath: String = 'file:/');
-var
- path: String;
- dir, filename, ext: String;
-
- f: file;
-begin
- while tar.hasNext do begin
- path := tar.NextFilename;
- dos.FSplit(path, dir, filename, ext);
-
- mkpath(targetpath + '/' + dir);
-
- Assign(f, targetpath + '/' + path);
- Rewrite(f, 1);
- tar.ExtractFile(f);
- Close(f);
- end;
-end;
-
-procedure Untar(tarfile: String; targetpath: String = 'file:/');
-var
- tar: TTarArchive;
-begin
- tar := TTarArchive.create(tarfile);
- Untar(tar, targetpath);
-end;
-
-
-
-procedure DrawProgress(http: HTTPRequest);
-const
- i: Integer = 0;
-begin
- Inc(i);
- if i mod 16 <> 0 then begin
- exit;
- end;
-
- if http.responseRemaining >= 0 then begin
- Write(#13, (http.responseLength - http.responseRemaining), '/', http.responseLength, ' Bytes empfangen');
- end else begin
- Write(#13, http.responseLength, ' Bytes empfangen');
- end;
-end;
-
-function Download(url, filename: String; do_untar: boolean = false): boolean;
-var
- f: File;
- httpc: HTTPRequest;
- tar: TTarArchive;
-begin
- Download := false;
- try
- httpc := HTTPRequest.create(url);
- httpc.setRequestHeader('Pragma', 'no-cache');
- httpc.setRequestHeader('Cache-Control', 'no-cache');
- WriteLn('Herunterladen von ', url);
- Write('Verbinde...');
- httpc.onReadTick := @DrawProgress;
- httpc.get;
- WriteLn;
-
- if httpc.statusCode <> 200 then begin
- WriteLn('Fehler: HTTP-Statuscode ', httpc.statusCode);
- end else if do_untar then begin
- tar := TTarArchive.create(httpc.binaryResponseBody, httpc.responseLength);
- Untar(tar);
- Download := true;
- end else begin
- Assign(f, filename);
- Rewrite(f, httpc.responseLength);
- BlockWrite(f, httpc.binaryResponseBody^, 1);
- Close(f);
- Download := true;
- end;
-
- httpc.done;
- except
- on e: Exception do WriteLn('EXCEPTION: ', e.message);
- end;
-
-end;
+uses crt, dos, sysutils, classes, tar, helpers, packages, repositories, baserepository;
procedure PrintUsage;
begin
@@ -124,70 +13,36 @@ end;
procedure Scan;
var
- f: Text;
- name: String;
- url: String;
- space: integer;
+ i: Integer;
+ repos: TCollection;
+ repo: TRepository;
begin
- mkpath(configRoot);
-
- Assign(f, configRoot + 'pkgsrc');
- Reset(f);
- while not eof(f) do begin
- ReadLn(f, url);
- if url = '' then begin
- continue;
- end;
+ mkpath(getConfigRoot);
- space := Pos(' ', url);
- if space > 0 then begin
- name := Copy(url, 1, space - 1);
- url := Copy(url, space + 1, length(url));
- end else begin
- WriteLn('Ungueltige Paketquelle: ' + url);
- continue;
- end;
-
- if url[length(url)] <> '/' then begin
- url := url + '/packages.' + arch;
- end else begin
- url := url + 'packages.' + arch;
- end;
+ ReadPkgsrc(getConfigRoot + 'pkgsrc');
+ repos := GetAllRepositories();
- WriteLn('Lade Paketliste ' + name + ' von ' + url);
- Download(url, configRoot + 'pkglist.' + name);
+ for i := 0 to repos.count - 1 do begin
+ repo := TRepository(repos.items[i]);
+ repo.PrepareLists();
end;
- Close(f);
end;
procedure ReadPkglists(pkgset: TPackageSet);
var
- srec: SearchRec;
- name: String;
repo: TRepository;
+ repos: TCollection;
+ i: integer;
begin
- dos.FindFirst(configRoot + 'pkglist.*', 0, srec);
- while DosError = 0 do begin
- WriteLn('Lese Paketliste ein: ' + srec.name);
-
- name := Copy(srec.name, length('pkglist.*'), length(srec.name));
- repo := GetRepository(name);
- if repo = nil then begin
- TextColor(6);
- WriteLn('Warnung: "', name, '" nicht in pkgsrc gefunden. Ueberspringe Quelle.');
- TextColor(7);
+ repos := GetAllRepositories();
+ for i := 0 to repos.count - 1 do begin
+ repo := TRepository(repos.items[i]);
+ Write('Lade Pakete von Repository ' + repo.name + ' - ');
+ if repo.FetchLists(pkgset) then begin
+ WriteLn('OK');
end else begin
- try
- pkgset.ScanFile(configRoot + srec.name, repo.url);
- except
- on e: Exception do begin
- TextColor(12);
- WriteLn('Fehler beim Einlesen der Paketliste: ', e.message);
- TextColor(7);
- end;
- end;
+ WriteLn('Fehler');
end;
- dos.FindNext(srec);
end;
end;
@@ -197,7 +52,8 @@ procedure Get(pkgname: String; reinstall: boolean);
function Install(version: TPackageVersion; reinstall: boolean): boolean;
var
filename: String;
- url: String;
+ repos: TRepository;
+ installarchive: TTarArchive;
begin
Install := false;
@@ -214,18 +70,20 @@ procedure Get(pkgname: String; reinstall: boolean);
exit;
end;
+ repos := GetRepository(version.repository);
+
// Ansonsten herunterladen und installieren
TextColor(15);
WriteLn('Herunterladen und Entpacken von ' + version.pkg.name + '/' + version.section.section);
TextColor(7);
- filename := version.pkg.name + '-' + version.section.section + '-' + version.version
- + '-' + arch + '.tar';
- url := version.repository + filename;
- if not Download(url, '', true) then begin
+ installarchive := repos.Download(version);
+ if installarchive = nil then begin
TextColor(12);
WriteLn('Download fehlgeschlagen');
TextColor(7);
exit;
+ end else begin
+ Untar(installarchive);
end;
WriteLn;
@@ -251,7 +109,7 @@ var
version: TPackageVersion;
i, j, k: integer;
begin
- ReadPkgsrc(configRoot + 'pkgsrc');
+ ReadPkgsrc(getConfigRoot + 'pkgsrc');
pkgset := TPackageSet.create;
ReadPkglists(pkgset);
@@ -267,14 +125,14 @@ begin
end;
version := pkgset.GetCurrentVersion(pkgname, section);
-
+
if version = nil then begin
TextColor(12);
WriteLn('Konnte keine Version von ' + pkgname + ' finden');
TextColor(7);
exit;
end;
-
+
instset := TPackageSet.create();
instset.AddVersion(version);
try
@@ -302,7 +160,6 @@ begin
end;
end;
end;
-
end;
procedure List;
@@ -318,7 +175,7 @@ var
i, j, k, l: integer;
begin
- ReadPkgsrc(configRoot + 'pkgsrc');
+ ReadPkgsrc(getConfigRoot + 'pkgsrc');
pkgset := TPackageSet.create;
ReadPkglists(pkgset);
diff --git a/trunk/src/modules/pas/lpt/packages.pas b/trunk/src/modules/pas/lpt/packages.pas
index eac8471..c1f4130 100644
--- a/trunk/src/modules/pas/lpt/packages.pas
+++ b/trunk/src/modules/pas/lpt/packages.pas
@@ -2,7 +2,7 @@ unit packages;
{$MODE ObjFPC}
interface
-uses sysutils, classes;
+uses sysutils, classes, tar;
type
EPackageFileFormat = class(Exception) end;
@@ -23,7 +23,6 @@ type
constructor create;
destructor destroy; override;
- procedure ScanFile(filename, repository: String);
function add(name: String): TPackage;
procedure AddAll(pkgset: TPackageSet);
procedure AddVersion(ver: TPackageVersion);
@@ -96,92 +95,6 @@ begin
packages.free;
end;
-procedure TPackageSet.ScanFile(filename, repository: String);
-var
- f: Text;
- line: String;
- status: integer;
-
- pkg: TPackage;
- section: TPackageSection;
- version: TPackageVersion;
-begin
- Assign(f, filename);
- Reset(f);
- status := 0;
- pkg := nil;
- try
- while not eof(f) do begin
- ReadLn(f, line);
-
- if line = '' then begin
- continue;
- end;
-
- case line[1] of
- 'P':
- begin
- status := 1;
- pkg := self.add(Copy(line, 3, length(line)));
- end;
- 'D':
- if status = 1 then begin
- pkg.desc := Copy(line, 3, length(line));
- end else begin
- raise EPackageFileFormat.create(
- 'D in status ' + IntToStr(status));
- end;
- 'S':
- if status >= 1 then begin
- status := 2;
- section := pkg.add(Copy(line, 3, length(line)));
- end else begin
- raise EPackageFileFormat.create(
- 'S in status ' + IntToStr(status));
- end;
- 'V':
- if status >= 2 then begin
- status := 3;
- version := section.add(Copy(line, 3, length(line)));
- version.pkg := pkg;
- version.section := section;
- version.repository := repository;
- end else begin
- raise EPackageFileFormat.create(
- 'V in status ' + IntToStr(status));
- end;
- 's':
- if status >= 3 then begin
- version.size := StrToInt(Copy(line, 3, length(line)));
- end else begin
- raise EPackageFileFormat.create(
- 's in status ' + IntToStr(status));
- end;
- 'd':
- if status >= 3 then begin
- if length(line) < 2 then begin
- raise EPackageFileFormat.create(
- 'Einsames d');
- end;
-
- version.addDependency(line[2], Copy(line, 4, length(line)));
-
- end else begin
- raise EPackageFileFormat.create(
- 'd in status ' + IntToStr(status));
- end;
- else
- begin
- raise EPackageFileFormat.create(
- 'Unbekannter Schluessel: ' + line[1]);
- end;
- end;
- end;
- finally
- Close(f);
- end;
-end;
-
function TPackageSet.add(name: String): TPackage;
var
pkg: TPackage;
diff --git a/trunk/src/modules/pas/lpt/repositories.pas b/trunk/src/modules/pas/lpt/repositories.pas
index 7484ab6..c68ec66 100644
--- a/trunk/src/modules/pas/lpt/repositories.pas
+++ b/trunk/src/modules/pas/lpt/repositories.pas
@@ -2,32 +2,47 @@ unit repositories;
{$MODE ObjFPC}
interface
-uses sysutils, classes;
-
-type
- TRepository = class(TCollectionItem)
- public
- name: String;
- url: String;
- end;
-
+uses sysutils, classes, helpers, baserepository, httprepository;
procedure ReadPkgsrc(filename: String);
+procedure AddRepository(name, url, repostype: String);
function GetRepository(name: String): TRepository;
-
+function GetAllRepositories(): TCollection;
implementation
var
repos: TCollection;
+procedure AddRepository(name, url, repostype: String);
+var
+ repo: TRepository;
+begin
+ if repostype = 'http' then begin
+ repo := THTTPRepository.create(repos);
+ end else begin
+ WriteLn('ACHTUNG - Repository unbekannten Typs erzeugen geht nicht!');
+ WriteLn('Angefordert: ' + repostype);
+ exit;
+ end;
+ repo.name := name;
+ repo.url := url;
+end;
+
+function GetAllRepositories(): TCollection;
+begin
+ exit(repos);
+end;
+
procedure ReadPkgsrc(filename: String);
var
repo: TRepository;
f: Text;
name: String;
url: String;
+ repostype: String;
space: integer;
+ protofinder: integer;
begin
Assign(f, filename);
Reset(f);
@@ -44,15 +59,19 @@ begin
if space > 0 then begin
name := Copy(url, 1, space - 1);
url := Copy(url, space + 1, length(url));
+ protofinder := Pos('http://', url);
+ if protofinder > 0 then begin
+ repostype := 'http';
+ end else begin
+ repostype := '';
+ end
end else begin
WriteLn('Ungueltige Paketquelle: ' + url);
continue;
end;
// Neues Repository in die Liste aufnehmen
- repo := TRepository(repos.add());
- repo.name := name;
- repo.url := url;
+ AddRepository(name, url, repostype);
end;
Close(f);
end;
Attachment:
signature.asc
Description: Digital signature