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