paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-04-08 00:02:03 +02:00
Code Issues Packages Projects Releases Wiki Activity

Added OpenSSL support for downloading files from https sites.

Browse Source 
git-svn-id: trunk@53631 -
This commit is contained in:
balazs 2016-12-11 10:26:18 +00:00
parent fe67ead20d
commit 8b5d771023
3 changed files with 73 additions and 26 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

6
components/onlinepackagemanager/opkman_const.pas
View File

@ -44,6 +44,12 @@ const
cRestrictedExtensionDef = '*.a,*.o,*.ppu,*.compiled,*.bak,*.or,*.rsj,*.~ ';
cRestrictedDirectoryDef = 'lib,backup';
cHelpPage = 'http://wiki.freepascal.org/Online_Package_Manager';
{$ifdef win64}
OpenSSLURL = 'http://packages.lazarus-ide.org/openssl-1.0.2j-x64_86-win64.zip';
{$endif}
{$ifdef win32}
OpenSSLURL = 'http://packages.lazarus-ide.org/openssl-1.0.2j-i386-win32.zip';
{$endif}
resourcestring
//package manager

35
components/onlinepackagemanager/opkman_downloader.pas
View File

@ -397,6 +397,8 @@ begin
UpdateSize := GetUpdateSize(SerializablePackages.Items[I].DownloadZipURL, FUErrMsg);
if UpdateSize > -1 then
begin
if UpdateSize = 0 then
UpdateSize := SerializablePackages.Items[I].RepositoryFileSize;
FUTyp := 1;
Synchronize(@DoOnPackageUpdateProgress);
Inc(UpdCnt);
@ -443,18 +445,19 @@ begin
DS.FOnWriteStream := @DoOnWriteStream;
try
FHTTPClient.AllowRedirect := True;
FHTTPClient.HTTPMethod('GET', FFrom, DS, [200]);
SerializablePackages.Items[I].ChangePackageStates(ctAdd, psDownloaded);
FHTTPClient.HTTPMethod('GET', FFrom, DS, []);
except
on E: Exception do
begin
FErrMsg := E.Message;
FErrTyp := etHTTPClient;
SerializablePackages.Items[I].ChangePackageStates(ctRemove, psDownloaded);
SerializablePackages.Items[I].ChangePackageStates(ctAdd, psError);
Synchronize(@DoOnPackageDownloadError);
end;
end;
if FHTTPClient.ResponseStatusCode <> 200 then
begin
FErrMsg := IntToStr(FHTTPClient.ResponseStatusCode);
FErrTyp := etHTTPClient;
SerializablePackages.Items[I].ChangePackageStates(ctRemove, psDownloaded);
SerializablePackages.Items[I].ChangePackageStates(ctAdd, psError);
Synchronize(@DoOnPackageDownloadError);
end
else
SerializablePackages.Items[I].ChangePackageStates(ctAdd, psDownloaded);
finally
DS.Free
end;
@ -564,15 +567,11 @@ begin
try
HttpClient.HTTPMethod('GET', URL, SS, []);
except
on E: Exception do
begin
if (UpperCase(E.Message) <> UpperCase('Operation aborted')) and
(UpperCase(E.Message) <> UpperCase('Chunk to big')) then
AErrMsg := E.Message;
end;
end;
if AErrMsg = '' then
Result := StrToIntDef(HttpClient.ResponseHeaders.Values['CONTENT-LENGTH'], 0);
if HttpClient.ResponseStatusCode = 200 then
Result := StrToIntDef(HttpClient.ResponseHeaders.Values['CONTENT-LENGTH'], 0)
else
AErrMsg := 'Error code: ' + IntToStr(HttpClient.ResponseStatusCode);
finally
HttpClient.Free;
end;

58
components/onlinepackagemanager/opkman_updates.pas
View File

@ -73,6 +73,7 @@ type
FNeedToBreak: Boolean;
FNeedToUpdate: Boolean;
FBusyUpdating: Boolean;
FOpenSSLAvaialable: Boolean;
FOnUpdate: TNotifyEvent;
FPaused: Boolean;
function GetUpdateInfo(const AURL: String; var AJSON: TJSONStringType): Boolean;
@ -83,6 +84,7 @@ type
procedure SetPaused(const AValue: Boolean);
procedure AssignPackageData(APackage: TPackage);
procedure ResetPackageData(APackage: TPackage);
procedure CheckForOpenSSL;
protected
procedure Execute; override;
public
@ -101,7 +103,7 @@ var
implementation
uses opkman_options, opkman_common;
uses opkman_options, opkman_common, opkman_const, opkman_zip;
{ TUpdatePackage }
@ -361,6 +363,42 @@ begin
end;
end;
procedure TUpdates.CheckForOpenSSL;
var
ZipFile: String;
UnZipper: TUnZipper;
begin
{$IFDEF MSWINDOWS}
FOpenSSLAvaialable := FileExistsUTF8(ExtractFilePath(ParamStr(0)) + 'libeay32.dll') and
FileExistsUTF8(ExtractFilePath(ParamStr(0)) + 'ssleay32.dll');
if not FOpenSSLAvaialable then
begin
ZipFile := ExtractFilePath(ParamStr(0)) + ExtractFileName(OpenSSLURL);
try
FHTTPClient.Get(OpenSSLURL, ZipFile);
except
end;
if FileExistsUTF8(ZipFile) then
begin
UnZipper := TUnZipper.Create;
try
try
UnZipper.FileName := ZipFile;
UnZipper.Examine;
UnZipper.UnZipAllFiles;
except
end;
finally
UnZipper.Free;
end;
DeleteFileUTF8(ZipFile);
FOpenSSLAvaialable := FileExistsUTF8(ExtractFilePath(ParamStr(0)) + 'libeay32.dll') and
FileExistsUTF8(ExtractFilePath(ParamStr(0)) + 'ssleay32.dll');
end;
end;
{$ENDIF}
end;
procedure TUpdates.DoOnTimer(Sender: TObject);
begin
if (FTimer.Enabled) and (not FNeedToBreak) then
@ -383,12 +421,15 @@ begin
try
FHTTPClient.AllowRedirect := True;
FHTTPClient.HTTPMethod('GET', URL, MS, []);
if Ms.Size > 0 then
if FHTTPClient.ResponseStatusCode = 200 then
begin
MS.Position := 0;
SetLength(AJSON, MS.Size);
MS.Read(Pointer(AJSON)^, Length(AJSON));
Result := Length(AJSON) > 0;
if Ms.Size > 0 then
begin
MS.Position := 0;
SetLength(AJSON, MS.Size);
MS.Read(Pointer(AJSON)^, Length(AJSON));
Result := Length(AJSON) > 0;
end;
end;
except
Result := False;
@ -410,9 +451,10 @@ var
JSON: TJSONStringType;
begin
Load;
CheckForOpenSSL;
while not Terminated do
begin
if (FNeedToUpdate) and (not FBusyUpdating) and (not FPaused) then
if (FNeedToUpdate) and (not FBusyUpdating) and (not FPaused) and (FOpenSSLAvaialable) then
begin
FBusyUpdating := True;
try
@ -448,6 +490,7 @@ end;
procedure TUpdates.StartUpdate;
begin
FOpenSSLAvaialable := False;
Load;
FPaused := False;
if FStarted then
@ -467,7 +510,6 @@ begin
FTimer.StopTimer;
FStarted := False;
FHTTPClient.NeedToBreak := True;
end;
procedure TUpdates.PauseUpdate;