paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-08-16 05:09:17 +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 (PackageManager.Options.GlobalSection.RemoteRepository='auto') then
begin begin
Log(llCommands,SLogDownloading,[PackageManager.Options.GlobalSection.RemoteMirrorsURL,PackageManager.Options.GlobalSection.LocalMirrorsFile]); 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; PackageManager.LoadLocalAvailableMirrors;
end; end;
// Download packages.xml // Download packages.xml
PackagesURL:=PackageManager.GetRemoteRepositoryURL(PackagesFileName); PackagesURL:=PackageManager.GetRemoteRepositoryURL(PackagesFileName);
Log(llCommands,SLogDownloading,[PackagesURL,PackageManager.Options.GlobalSection.LocalPackagesFile]); 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 // Read the repository again
PackageManager.ScanAvailablePackages; PackageManager.ScanAvailablePackages;
// no need to log errors again // no need to log errors again

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

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

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

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

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

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

22
utils/fppkg/pkglnet.pp
View File

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