[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]

Re: [tyndur-devel] [PATCH] + lpt: Repositories als abstrakte Klassen



Aufspaltungen gibts erstmal nicht, die doof-Hunks werden auch nicht korrigiert, macht Kate eh wieder so.
Hoffe das diesmal alles drin ist. *g*

-- 
Alexander Siol
alex@xxxxxxxxxx
dunklermeuchler@xxxxxxxxx
diff --git a/trunk/src/modules/pas/lpt/helpers.pas b/trunk/src/modules/pas/lpt/helpers.pas
new file mode 100644
index 0000000..49e03b8
--- /dev/null
+++ b/trunk/src/modules/pas/lpt/helpers.pas
@@ -0,0 +1,233 @@
+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 StartDownload(url: String): HTTPRequest;
+function DownloadToFile(url, filename: String): boolean;
+function DownloadToTarArchive(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 StartDownload(url: String): HTTPRequest;
+var
+    httpc: HTTPRequest;
+begin
+    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
+        exit(httpc);
+    end else begin
+        WriteLn('Fehler: HTTP-Statuscode ', httpc.statusCode);
+        exit(nil)
+    end;
+end;
+
+function DownloadToFile(url, filename: String): boolean;
+var
+    f: File;
+    httpc: HTTPRequest;
+    tar: TTarArchive;
+    i: integer;
+begin
+    DownloadToFile := false;
+    httpc := StartDownload(url);
+    if httpc <> nil then begin
+        Assign(f, filename);
+        Rewrite(f, httpc.responseLength);
+        BlockWrite(f, httpc.binaryResponseBody^, 1);
+        Close(f);
+        DownloadToFile := true;
+        httpc.done;
+    end;
+end;
+
+function DownloadToTarArchive(url: String): TTarArchive;
+var
+    f: File;
+    httpc: HTTPRequest;
+    tar: TTarArchive;
+    i: integer;
+begin
+    DownloadToTarArchive := nil;
+    httpc := StartDownload(url);
+    if httpc <> nil then begin
+        tar := TTarArchive.create(httpc.binaryResponseBody, httpc.responseLength);
+        DownloadToTarArchive := tar;
+    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/lpt.pas b/trunk/src/modules/pas/lpt/lpt.pas
index 62e0980..7f0c6c9 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, repository_base;
 
 procedure PrintUsage;
 begin
@@ -124,70 +13,58 @@ 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;
+    try
+        ReadPkgsrc(getConfigRoot + 'pkgsrc');
+    except
+        on e: Exception do begin
+            TextColor(12);
+            WriteLn('Kann Repository-Liste nicht laden:');
+            WriteLn(e.message);
+            TextColor(7);
         end;
-
-        if url[length(url)] <> '/' then begin
-            url := url + '/packages.' + arch;
-        end else begin
-            url := url + 'packages.' + arch;
+    end;
+    repos := GetAllRepositories();
+
+    for i := 0 to repos.count - 1 do begin
+        repo := TRepository(repos.items[i]);
+        try
+            repo.PrepareLists();
+        except
+            on e: EDownload do begin
+                TextColor(12);
+                WriteLn('Download der Paketliste für ' + repo.name + ' fehlgeschlagen:');
+                WriteLn(e.message);
+                TextColor(7);
+            end;
         end;
-
-        WriteLn('Lade Paketliste ' + name + ' von ' + url);
-        Download(url, configRoot + 'pkglist.' + name);
     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);
-        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;
+    repos := GetAllRepositories();
+    for i := 0 to repos.count - 1 do begin
+        repo := TRepository(repos.items[i]);
+        try
+            repo.FetchLists(pkgset);
+            WriteLn('Laden der Pakete von ' + repo.name + 'erfolgreich.');
+        except
+            on e: Exception do begin
+                TextColor(12);
+                WriteLn('Fehler: ' + e.message);
+                TextColor(7);
             end;
         end;
-        dos.FindNext(srec);
     end;
 end;
 
@@ -197,7 +74,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,20 +92,16 @@ 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
-            TextColor(12);
-            WriteLn('Download fehlgeschlagen');
-            TextColor(7);
-            exit;
+        installarchive := repos.Download(version);
+        if installarchive <> nil then begin
+            Untar(installarchive);
         end;
-        WriteLn;
 
         filename := 'file:/packages/' + version.pkg.name + '/' +
             version.version + '/postinstall-' + version.section.section;
@@ -251,10 +125,19 @@ var
     version: TPackageVersion;
     i, j, k: integer;
 begin
-    ReadPkgsrc(configRoot + 'pkgsrc');
-    pkgset := TPackageSet.create;
+    try
+        ReadPkgsrc(getConfigRoot + 'pkgsrc');
+        pkgset := TPackageSet.create;
 
-    ReadPkglists(pkgset);
+        ReadPkglists(pkgset);
+    except
+        on e: EPackageList do begin
+            TextColor(12);
+            WriteLn('Kann die Paketlisten nicht einlesen: ');
+            WriteLn(e.message);
+            TextColor(7);
+        end;
+    end;
 
     // Parameter hat die Form Paketname/Section. Wenn keine Section angegeben
     // ist, wird bin als Default benutzt.
@@ -267,14 +150,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
@@ -295,14 +178,18 @@ begin
             sect := TPackageSection(pkg.sections.items[j]);
             for k := 0 to sect.versions.count - 1 do begin
                 version := TPackageVersion(sect.versions.items[k]);
-                if not Install(version, reinstall) then begin
-                    WriteLn('Breche Paketinstallationen ab.');
-                    exit;
+                try
+                    Install(version, reinstall);
+                except
+                    on e: Exception do begin
+                        TextColor(12);
+                        WriteLn('Fehler: ' + e.message);
+                        TextColor(7);
+                    end;
                 end;
             end;
         end;
     end;
-
 end;
 
 procedure List;
@@ -318,7 +205,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..aa08149 100644
--- a/trunk/src/modules/pas/lpt/repositories.pas
+++ b/trunk/src/modules/pas/lpt/repositories.pas
@@ -2,31 +2,43 @@ unit repositories;
 {$MODE ObjFPC}
 
 interface
-uses sysutils, classes;
-
-type
-    TRepository = class(TCollectionItem)
-        public
-            name:   String;
-            url:    String;
-    end;
-
+uses crt, sysutils, classes, helpers, repository_base, repository_http;
 
 procedure ReadPkgsrc(filename: String);
+procedure AddRepository(name, url: String; repostype: Trepostype);
 function GetRepository(name: String): TRepository;
-
+function GetAllRepositories(): TCollection;
 
 implementation
 
 var
     repos: TCollection;
 
+procedure AddRepository(name, url: String; repostype: Trepostype);
+var
+    repo: TRepository;
+begin
+    if repostype = http then begin
+        repo := THTTPRepository.create(repos);
+    end else begin
+        raise EInvalidRepository.create('Repository unbekannten Types!');
+    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: Trepostype;
     space: integer;
 begin
     Assign(f, filename);
@@ -35,7 +47,7 @@ begin
         ReadLn(f, url);
 
         // Leerzeilen ignorieren
-        if url = '' then begin
+        if (url = '') or (url[0] = '#') then begin
             continue;
         end;
 
@@ -44,15 +56,23 @@ begin
         if  space > 0 then begin
             name := Copy(url, 1, space - 1);
             url := Copy(url, space + 1, length(url));
+            if Pos('http://', url) > 0 then begin
+                repostype := http;
+            end else begin
+                TextColor(12);
+                WriteLn('Ungueltige Paketquelle: ' + url);
+                TextColor(7);
+                continue;
+            end
         end else begin
+            TextColor(12);
             WriteLn('Ungueltige Paketquelle: ' + url);
+            TextColor(7);
             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;
diff --git a/trunk/src/modules/pas/lpt/repository_base.pas b/trunk/src/modules/pas/lpt/repository_base.pas
new file mode 100644
index 0000000..eb999f7
--- /dev/null
+++ b/trunk/src/modules/pas/lpt/repository_base.pas
@@ -0,0 +1,44 @@
+unit repository_base;
+{$MODE ObjFPC}
+
+interface
+uses sysutils, classes, tar, packages, helpers;
+
+type
+    EDownload = class(Exception) end;
+    EPackageList = class(Exception) end;
+    EInvalidRepository = class(Exception) end;
+
+    Trepostype = ( none, http );
+
+    TRepository = class(TCollectionItem)
+        public
+            name:   String;
+            url:    String;
+
+
+            (* Erzeugt ein Repository. *)
+            constructor create(parent : TCollection);
+            (* Liefert den Typ des Repository *)
+            function repostype: Trepostype; virtual;
+            (* Lädt die angegebene Paketversion aus dem Repository *)
+            function Download(version: TPackageVersion): TTarArchive; virtual; abstract;
+            (* Bereitet Paketlisten für das Repository vor (siehe lpt scan) *)
+            procedure PrepareLists; virtual; abstract;
+            (* Lädt die Paketliste des Repository in ein PackageSet *)
+            procedure FetchLists(pkgset: TPackageSet); virtual; abstract;
+    end;
+
+implementation
+
+constructor TRepository.create(parent: TCollection);
+begin
+    inherited;
+end;
+
+function TRepository.repostype: Trepostype;
+begin
+    exit(none);
+end;
+
+end.
diff --git a/trunk/src/modules/pas/lpt/repository_http.pas b/trunk/src/modules/pas/lpt/repository_http.pas
new file mode 100644
index 0000000..759cbc6
--- /dev/null
+++ b/trunk/src/modules/pas/lpt/repository_http.pas
@@ -0,0 +1,68 @@
+unit repository_http;
+{$MODE ObjFPC}
+
+interface
+uses crt, sysutils, classes, tar, packages, helpers, repository_base;
+
+type
+    THTTPRepository = class(TRepository)
+        public
+            constructor create(parent : TCollection);
+            function repostype: Trepostype; override;
+            function Download(version: TPackageVersion): TTarArchive; override;
+            procedure PrepareLists; override;
+            procedure FetchLists(pkgset: TPackageSet); override;
+    end;
+
+implementation
+
+constructor THTTPRepository.create(parent : TCollection);
+begin
+    inherited;
+end;
+
+function THTTPRepository.repostype: Trepostype;
+begin
+    exit(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(DownloadToTarArchive(archiveURI));
+end;
+
+procedure THTTPRepository.PrepareLists;
+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);
+    try
+        DownloadToFile(pkglisturl, getConfigRoot + 'pkglist.' + self.name);
+    except
+        on e: Exception do begin
+            raise EDownload.create(e.message);
+        end;
+    end;
+end;
+
+procedure THTTPRepository.FetchLists(pkgset: TPackageSet);
+begin
+    if FileExists(getConfigRoot + 'pkglist.' + self.name) then begin
+        ScanFile(pkgset, getConfigRoot + 'pkglist.' + self.name, self.name);
+    end else begin
+        raise EPackageList.create('Keine Paketliste für ' + self.name + ' vorhanden!');
+    end;
+end;
+
+end.

Attachment: signature.asc
Description: Digital signature