paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-04-16 01:39:27 +02:00
Code Issues Packages Projects Releases Wiki Activity

* Propagate the result of download-actions to avoid stale empty files

Browse Source 
git-svn-id: trunk@36530 -
This commit is contained in:
joost 2017-06-18 21:54:42 +00:00
parent 187724d844
commit 6bb48bf34f
5 changed files with 68 additions and 42 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

4
packages/fppkg/src/pkgcommands.pp
View File

@ -255,13 +255,13 @@ begin
(PackageManager.Options.GlobalSection.RemoteRepository='auto') then
begin
Log(llCommands,SLogDownloading,[PackageManager.Options.GlobalSection.RemoteMirrorsURL,PackageManager.Options.GlobalSection.LocalMirrorsFile]);
DownloadFile(PackageManager.Options.GlobalSection.RemoteMirrorsURL,PackageManager.Options.GlobalSection.LocalMirrorsFile, PackageManager);
Result := DownloadFile(PackageManager.Options.GlobalSection.RemoteMirrorsURL,PackageManager.Options.GlobalSection.LocalMirrorsFile, PackageManager);
PackageManager.LoadLocalAvailableMirrors;
end;
// Download packages.xml
PackagesURL:=PackageManager.GetRemoteRepositoryURL(PackagesFileName);
Log(llCommands,SLogDownloading,[PackagesURL,PackageManager.Options.GlobalSection.LocalPackagesFile]);
DownloadFile(PackagesURL,PackageManager.Options.GlobalSection.LocalPackagesFile,PackageManager);
Result := Result and DownloadFile(PackagesURL,PackageManager.Options.GlobalSection.LocalPackagesFile,PackageManager);
// Read the repository again
PackageManager.ScanAvailablePackages;
// no need to log errors again

51
packages/fppkg/src/pkgdownload.pp
View File

@ -16,12 +16,12 @@ Type
FBackupFile : Boolean;
Protected
// Needs overriding.
Procedure FTPDownload(Const URL : String; Dest : TStream); Virtual;
Procedure HTTPDownload(Const URL : String; Dest : TStream); Virtual;
Procedure FileDownload(Const URL : String; Dest : TStream); Virtual;
function FTPDownload(Const URL : String; Dest : TStream): Boolean; Virtual;
function HTTPDownload(Const URL : String; Dest : TStream): Boolean; Virtual;
function FileDownload(Const URL : String; Dest : TStream): Boolean; Virtual;
Public
Procedure Download(Const URL,DestFileName : String);
Procedure Download(Const URL : String; Dest : TStream);
function Download(Const URL,DestFileName : String): Boolean;
function Download(Const URL : String; Dest : TStream): Boolean;
Property BackupFiles : Boolean Read FBackupFile Write FBackupFile;
end;
TBaseDownloaderClass = Class of TBaseDownloader;
@ -36,7 +36,7 @@ Type
procedure RegisterDownloader(const AName:string;Downloaderclass:TBaseDownloaderClass);
function GetDownloader(const AName:string):TBaseDownloaderClass;
procedure DownloadFile(const RemoteFile,LocalFile:String; PackageManager: TpkgFPpkg);
function DownloadFile(const RemoteFile,LocalFile:String; PackageManager: TpkgFPpkg): Boolean;
implementation
@ -72,14 +72,14 @@ begin
end;
procedure DownloadFile(const RemoteFile,LocalFile:String; PackageManager: TpkgFPpkg);
function DownloadFile(const RemoteFile,LocalFile:String; PackageManager: TpkgFPpkg): Boolean;
var
DownloaderClass : TBaseDownloaderClass;
begin
DownloaderClass:=GetDownloader(PackageManager.Options.GlobalSection.Downloader);
with DownloaderClass.Create(nil) do
try
Download(RemoteFile,LocalFile);
Result := Download(RemoteFile,LocalFile);
finally
Free;
end;
@ -88,72 +88,81 @@ end;
{ TBaseDownloader }
procedure TBaseDownloader.FTPDownload(const URL: String; Dest: TStream);
function TBaseDownloader.FTPDownload(Const URL: String; Dest: TStream): Boolean;
begin
Error(SErrNoFTPDownload);
Result := False;
end;
procedure TBaseDownloader.HTTPDownload(const URL: String; Dest: TStream);
function TBaseDownloader.HTTPDownload(Const URL: String; Dest: TStream): Boolean;
begin
Error(SErrNoHTTPDownload);
Result := False;
end;
procedure TBaseDownloader.FileDownload(const URL: String; Dest: TStream);
function TBaseDownloader.FileDownload(Const URL: String; Dest: TStream): Boolean;
Var
FN : String;
F : TFileStream;
begin
Result := False;
URIToFilename(URL,FN);
If Not FileExists(FN) then
Error(SErrNoSuchFile,[FN]);
F:=TFileStream.Create(FN,fmOpenRead);
Try
Dest.CopyFrom(F,0);
Result := True;
Finally
F.Free;
end;
end;
procedure TBaseDownloader.Download(const URL, DestFileName: String);
function TBaseDownloader.Download(Const URL, DestFileName: String): Boolean;
Var
F : TFileStream;
begin
Result := False;
If FileExists(DestFileName) and BackupFiles then
BackupFile(DestFileName);
try
F:=TFileStream.Create(DestFileName,fmCreate);
try
Download(URL,F);
Result := Download(URL,F);
finally
F.Free;
end;
except
DeleteFile(DestFileName);
raise;
finally
if not Result then
DeleteFile(DestFileName);
end;
end;
procedure TBaseDownloader.Download(const URL: String; Dest: TStream);
function TBaseDownloader.Download(Const URL: String; Dest: TStream): Boolean;
Var
URI : TURI;
P : String;
begin
Result := False;
URI:=ParseURI(URL);
P:=URI.Protocol;
If CompareText(P,'ftp')=0 then
FTPDownload(URL,Dest)
Result := FTPDownload(URL,Dest)
else if (CompareText(P,'http')=0) or (CompareText(P,'https')=0) then
HTTPDownload(URL,Dest)
Result := HTTPDownload(URL,Dest)
else if CompareText(P,'file')=0 then
FileDownload(URL,Dest)
Result := FileDownload(URL,Dest)
else
Error(SErrUnknownProtocol,[P, URL]);
begin
Error(SErrUnknownProtocol,[P, URL]);
Result := False;
end;
end;

9
packages/fppkg/src/pkgfphttp.pp
View File

@ -7,9 +7,12 @@ interface
uses Classes,pkgdownload,pkgoptions,fprepos;
Type
{ TFPHTTPDownloader }
TFPHTTPDownloader = Class(TBaseDownloader)
Protected
Procedure HTTPDownload(Const URL : String; Dest : TStream); override;
function HTTPDownload(Const URL : String; Dest : TStream): Boolean; override;
end;
implementation
@ -17,14 +20,16 @@ implementation
uses
sysutils,fphttpclient, pkgglobals, pkgmessages;
Procedure TFPHTTPDownloader.HTTPDownload(Const URL : String; Dest : TStream);
function TFPHTTPDownloader.HTTPDownload(Const URL: String; Dest: TStream): Boolean;
begin
Result := False;
With TFPHTTPClient.Create(Nil) do
try
AllowRedirect := True;
Get(URL,Dest);
Dest.Position:=0;
Result := True;
finally
Free;
end;

24
packages/fppkg/src/pkgwget.pp
View File

@ -7,14 +7,17 @@ interface
uses Classes,pkgdownload,pkgoptions,fprepos;
Type
{ TWGetDownloader }
TWGetDownloader = Class(TBaseDownloader)
Private
FWGet : String;
Protected
Constructor Create(AOwner: TComponent); override;
Procedure WGetDownload(Const URL : String; Dest : TStream); virtual;
Procedure FTPDownload(Const URL : String; Dest : TStream); override;
Procedure HTTPDownload(Const URL : String; Dest : TStream); override;
function WGetDownload(Const URL : String; Dest : TStream): Boolean; virtual;
function FTPDownload(Const URL : String; Dest : TStream): Boolean; override;
function HTTPDownload(Const URL : String; Dest : TStream): Boolean; override;
Public
Property WGet : String Read FWGet Write FWGet;
end;
@ -34,13 +37,14 @@ begin
end;
Procedure TWGetDownloader.WGetDownload(Const URL : String; Dest : TStream);
function TWGetDownloader.WGetDownload(Const URL: String; Dest: TStream): Boolean;
Var
Buffer : Array[0..4096] of byte;
Count : Integer;
begin
Result := False;
With TProcess.Create(Self) do
try
CommandLine:=WGet+' -q --output-document=- '+url;
@ -53,22 +57,24 @@ begin
Dest.WriteBuffer(Buffer,Count);
end;
If (ExitStatus<>0) then
Error(SErrDownloadFailed,['WGET',URL,Format('exit status %d',[ExitStatus])]);
Error(SErrDownloadFailed,['WGET',URL,Format('exit status %d',[ExitStatus])])
else
Result := True;
finally
Free;
end;
end;
Procedure TWGetDownloader.FTPDownload(Const URL : String; Dest : TStream);
function TWGetDownloader.FTPDownload(Const URL: String; Dest: TStream): Boolean;
begin
WGetDownload(URL,Dest);
Result := WGetDownload(URL,Dest);
end;
Procedure TWGetDownloader.HTTPDownload(Const URL : String; Dest : TStream);
function TWGetDownloader.HTTPDownload(Const URL: String; Dest: TStream): Boolean;
begin
WGetDownload(URL,Dest);
Result := WGetDownload(URL,Dest);
end;
initialization

22
utils/fppkg/pkglnet.pp
View File

@ -32,8 +32,8 @@ Type
procedure OnFTPSuccess(aSocket: TLSocket; const aStatus: TLFTPStatus);
procedure OnFTPFailure(aSocket: TLSocket; const aStatus: TLFTPStatus);
// overrides
procedure FTPDownload(Const URL : String; Dest : TStream); override;
procedure HTTPDownload(Const URL : String; Dest : TStream); override;
function FTPDownload(Const URL : String; Dest : TStream): Boolean; override;
function HTTPDownload(Const URL: String; Dest: TStream): Boolean; override;
public
constructor Create(AOwner : TComponent); override;
end;
@ -100,8 +100,9 @@ begin
FQuit:=True;
end;
procedure TLNetDownloader.FTPDownload(const URL: String; Dest: TStream);
function TLNetDownloader.FTPDownload(Const URL: String; Dest: TStream): Boolean;
begin
Result := False;
FOutStream:=Dest;
Try
{ parse URL }
@ -115,9 +116,11 @@ begin
FFTP.CallAction;
if not FQuit then begin
FFTP.Authenticate(URI.Username, URI.Password);
FFTP.ChangeDirectory(URI.Path);
FFTP.Retrieve(URI.Document);
Result := FFTP.Authenticate(URI.Username, URI.Password);
if Result then
Result := FFTP.ChangeDirectory(URI.Path);
if Result then
Result := FFTP.Retrieve(URI.Document);
while not FQuit do
FFTP.CallAction;
end;
@ -126,8 +129,9 @@ begin
end;
end;
procedure TLNetDownloader.HTTPDownload(const URL: String; Dest: TStream);
function TLNetDownloader.HTTPDownload(Const URL: String; Dest: TStream): Boolean;
begin
Result := False;
FOutStream:=Dest;
Try
{ parse aURL }
@ -146,7 +150,9 @@ begin
while not FQuit do
FHTTP.CallAction;
if FHTTP.Response.Status<>HSOK then
Error(SErrDownloadFailed,['HTTP',EncodeURI(URI),FHTTP.Response.Reason]);
Error(SErrDownloadFailed,['HTTP',EncodeURI(URI),FHTTP.Response.Reason])
else
Result := True;
Finally
FOutStream:=nil; // to be sure
end;