diff --git a/lazproj/dexed.lpi b/lazproj/dexed.lpi
index 457db921..d122dc69 100644
--- a/lazproj/dexed.lpi
+++ b/lazproj/dexed.lpi
@@ -526,7 +526,7 @@
-
+
@@ -842,6 +842,10 @@
+
+
+
+
diff --git a/lazproj/dexed.lpr b/lazproj/dexed.lpr
index 868cf468..033969d3 100644
--- a/lazproj/dexed.lpr
+++ b/lazproj/dexed.lpr
@@ -13,7 +13,7 @@ uses
u_processes, u_dialogs, u_dubprojeditor, u_controls, u_dfmt,
u_lcldragdrop, u_stringrange, u_dlangmaps, u_projgroup, u_projutils,
u_d2synpresets, u_dastworx, u_dbgitf, u_ddemangle, u_dubproject,
- u_halstead, u_diff, u_profileviewer, u_semver, u_term;
+ u_halstead, u_diff, u_profileviewer, u_semver, u_term, u_simpleget;
{$R *.res}
diff --git a/setup/setup.d b/setup/setup.d
index 6e44c927..8328c3f0 100644
--- a/setup/setup.d
+++ b/setup/setup.d
@@ -1,7 +1,8 @@
module setup;
import
- std.stdio, std.file, std.process, std.path, std.string, std.getopt;
+ std.stdio, std.file, std.process, std.path, std.string, std.getopt,
+ std.algorithm.iteration;
version(X86) version(linux) version = nux32;
version(X86_64) version(linux) version = nux64;
@@ -55,6 +56,14 @@ immutable Resource[] oldResources =
Resource(cast(ImpType) [], "cetodo" ~ exeExt, Kind.exe),
];
+version(Windows)
+ immutable Resource[] systemRelResources =
+ [
+ Resource(cast(ImpType) import("libcurl.dll"), "libcurl.dll", Kind.exe)
+ ];
+else
+ immutable Resource[] systemRelResources = [];
+
struct Formater
{
private enum width = 54;
@@ -195,7 +204,7 @@ void main(string[] args)
size_t failures;
bool done;
- if(!uninstall)
+ if (!uninstall)
{
static immutable extractMsg = [": FAILURE", ": extracted"];
static immutable oldMsg = [": FAILURE", ": removed old file"];
@@ -205,6 +214,12 @@ void main(string[] args)
Formater.justify!'L'(res.destName ~ extractMsg[done]);
failures += !done;
}
+ foreach (ref res; systemRelResources)
+ {
+ done = installResource(res);
+ Formater.justify!'L'(res.destName ~ extractMsg[done]);
+ failures += !done;
+ }
foreach (ref res; oldResources)
{
if (!res.targetFilename.exists)
@@ -256,6 +271,12 @@ void main(string[] args)
Formater.justify!'L'(res.destName ~ rmMsg[done]);
failures += !done;
}
+ foreach (ref res; systemRelResources)
+ {
+ done = uninstallResource(res);
+ Formater.justify!'L'(res.destName ~ rmMsg[done]);
+ failures += !done;
+ }
if (!noTools) foreach (ref res; thirdPartBinaries)
{
done = uninstallResource(res);
diff --git a/src/u_libmaneditor.pas b/src/u_libmaneditor.pas
index 29367db1..ac9871b1 100644
--- a/src/u_libmaneditor.pas
+++ b/src/u_libmaneditor.pas
@@ -6,8 +6,7 @@ interface
uses
Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, ExtCtrls,
- Menus, ComCtrls, Buttons, LazFileUtils, fphttpclient, StdCtrls,
- fpjson, jsonparser,
+ Menus, ComCtrls, Buttons, LazFileUtils, StdCtrls, fpjson,
u_widget, u_interfaces, u_ceproject, u_dmdwrap, u_common, u_dialogs,
u_sharedres, process, u_dubproject, u_observer, u_libman,
u_projutils, u_dsgncontrols, u_controls;
@@ -88,6 +87,8 @@ type
implementation
{$R *.lfm}
+uses
+ u_simpleget;
const
notav: string = '< n/a >';
enableStr: array [boolean] of string = ('false','true');
@@ -330,31 +331,14 @@ begin
end;
procedure TDubPackageQueryForm.getList(sender: TObject);
-var
- pge: string;
- cli: TFPHTTPClient;
- prs: TJSONParser;
begin
if assigned(fList) then
fList.free;
- cli := TFPHTTPClient.Create(nil);
- try
- try
- //TODO: use HTTPS when FCL-WEB will allow it again.
- pge := cli.Get('http://code.dlang.org/api/packages/search');
- except
- pge := '[]';
- end;
- finally
- cli.Free;
- end;
- prs := TJSONParser.Create(pge, []);
- try
- fList := prs.Parse;
- finally
- prs.Free;
- end;
- fillList;
+ simpleGet('http://code.dlang.org/api/packages/search', fList);
+ if assigned(fList) then
+ fillList
+ else
+ dlgOkError('could not get the package list, check you connection or that curl library is setup');
end;
procedure TDubPackageQueryForm.fillList;
@@ -386,33 +370,24 @@ var
jsn: TJSONData;
begin
result := 'master';
- if fGetLatestTag then
+ if not fGetLatestTag then
+ exit;
+ // list is updated
+ if fList.isNotNil and (cbb.ItemIndex <> -1) and
+ cbb.Items.Objects[cbb.ItemIndex].isNotNil then
begin
- // list is updated
- if fList.isNotNil and (cbb.ItemIndex <> -1) and
- cbb.Items.Objects[cbb.ItemIndex].isNotNil then
- begin
- jsn := TJSONData(cbb.Items.Objects[cbb.ItemIndex]);
- jsn := jsn.FindPath('version');
- result := jsn.AsString;
- end
- else
- // use API
- begin
- with TFPHTTPClient.Create(nil) do
- try
- try
- //TODO: use HTTPS when FCL-WEB will allow it again.
- result := Get('http://code.dlang.org/api/packages/' + packageName + '/latest');
- except
- result := 'master';
- end;
- finally
- Free;
- end;
- if (result.length >= 7) and (result[2] in ['0'..'9']) then
- result := result[2..result.length-1]
- end;
+ jsn := TJSONData(cbb.Items.Objects[cbb.ItemIndex]);
+ jsn := jsn.FindPath('version');
+ result := jsn.AsString;
+ end
+ // use API
+ else
+ begin
+ result := '';
+ if not simpleGet('http://code.dlang.org/api/packages/' + packageName + '/latest', result) then
+ result := 'master';
+ if (result.length >= 7) and (result[2] in ['0'..'9']) then
+ result := result[2..result.length-1]
end;
end;
diff --git a/src/u_main.pas b/src/u_main.pas
index a533e67a..1af5eeec 100644
--- a/src/u_main.pas
+++ b/src/u_main.pas
@@ -8,9 +8,9 @@ uses
Classes, SysUtils, LazFileUtils, SynEditKeyCmds, SynHighlighterLFM, Forms,
StdCtrls, AnchorDocking, AnchorDockStorage, AnchorDockOptionsDlg, Controls,
Graphics, strutils, Dialogs, Menus, ActnList, ExtCtrls, process,
- {$IFDEF WINDOWS}Windows, {$ENDIF} XMLPropStorage, SynExportHTML, fphttpclient,
- fpjson, jsonparser, jsonscanner, LCLIntf,
- u_common, u_ceproject, u_synmemo, u_writableComponent,
+ {$IFDEF WINDOWS}Windows, {$ENDIF} XMLPropStorage, SynExportHTML,
+ fpjson, jsonscanner, LCLIntf,
+ u_common, u_ceproject, u_synmemo, u_writableComponent, u_simpleget,
u_widget, u_messages, u_interfaces, u_editor, u_projinspect, u_ceprojeditor,
u_search, u_miniexplorer, u_libman, u_libmaneditor, u_todolist, u_observer,
u_toolseditor, u_procinput, u_optionseditor, u_symlist, u_mru, u_processes,
@@ -2000,56 +2000,19 @@ function checkForUpdate: string;
const
updURL = 'https://api.github.com/repos/Basile-z/dexed/releases/latest';
var
- prs: TJSONParser = nil;
dat: TJSONData = nil;
tgg: TJSONData = nil;
url: TJSONData = nil;
str: string = '';
- cli: TFPHTTPClient = nil;
lst: TStringList = nil;
res: TResourceStream = nil;
svo: TSemVer;
sva: TSemVer;
begin
result := '';
-
- if openssl.IsSSLloaded then
+ if simpleGet(updURL, dat) then
begin
try
- cli := TFPHTTPClient.Create(nil);
- try
- cli.AllowRedirect:=true;
- cli.AddHeader('User-Agent','Mozilla/5.0 (compatible; fpweb)');
- str := cli.Get(updURL);
- finally
- cli.free;
- end;
- except
- dlgOkError('The latest release cannot be determined (HTTP client)');
- end;
- end
-
- else if not openssl.IsSSLloaded and exeFullName('curl').isNotEmpty then
- begin
- if not process.RunCommand('curl', [updURL], str) then
- begin
- dlgOkError('The latest release cannot be determined (CURL)');
- exit;
- end
- end
- else
- begin
- dlgOkInfo('No suitable tool can be used to determine the latest version.' +
- 'Install at least CURL as a command line tool, visible in the PATH.' +
- 'Newest OpenSSL versions (>= 1.1) are currently not supported');
- exit;
- end;
-
- prs := TJSONParser.Create(str, [joUTF8, joIgnoreTrailingComma]);
- try
- dat := prs.Parse;
- if dat.isNotNil then
- begin
url := dat.FindPath('html_url');
tgg := dat.FindPath('tag_name');
if url.isNotNil and tgg.isNotNil and (tgg.AsString <> '3_update_5') then
@@ -2062,16 +2025,17 @@ begin
str := tgg.AsString;
svo.init(str, false);
if svo.valid and sva.valid and (svo > sva) then
- result := url.AsString;
+ result := url.AsString
+ else
+ dlgOkInfo('No new release available');
end;
+ finally
+ dat.free;
+ lst.free;
+ res.free;
end;
- finally
- prs.Free;
- dat.free;
- lst.free;
- res.free;
- end;
-
+ end
+ else dlgOkError('Impossible to check new versions, no connectivity or lib CURL not installed');
end;
procedure TMainForm.DoFirstShow;
@@ -2150,8 +2114,7 @@ begin
if dlgYesNo('An new release is available, do you wish to visit the release page ?' +
lineEnding + '(' + url +')') = mrYes then
OpenURL(url);
- end
- else dlgOkInfo('No new release available or no connectivity');
+ end;
end;
procedure TMainForm.mnuItemManualClick(Sender: TObject);
diff --git a/src/u_simpleget.pas b/src/u_simpleget.pas
new file mode 100644
index 00000000..e7d2fa20
--- /dev/null
+++ b/src/u_simpleget.pas
@@ -0,0 +1,129 @@
+unit u_simpleget;
+
+{$I u_defines.inc}
+
+interface
+
+uses
+ classes, libcurl, fpjson, jsonparser, jsonscanner;
+
+type
+ PStream = ^TStream;
+
+// Get the content of url in the string data
+function simpleGet(url: string; var data: string): boolean; overload;
+// Get the content of url in the stream data
+function simpleGet(url: string; data: TStream): boolean; overload;
+// Get the content of url in the JSON data, supposed to be a nil instance.
+function simpleGet(url: string; var data: TJSONData): boolean; overload;
+
+implementation
+
+var
+ fCurlHandle: CURL = nil;
+
+function curlHandle(): CURL;
+begin
+ if not assigned(fCurlHandle) then
+ begin
+ curl_global_init(CURL_GLOBAL_SSL or CURL_GLOBAL_ALL);
+ fCurlHandle := curl_easy_init();
+ end;
+ result := fCurlHandle;
+end;
+
+function simpleGetClbckForStream(buffer:Pchar; size:PtrInt; nitems:PtrInt;
+ appender: PStream): PtrInt; cdecl;
+begin
+ assert(appender <> nil);
+ try
+ result := appender^.write(buffer^, size * nitems);
+ except
+ result := 0;
+ end;
+end;
+
+function simpleGetClbckForString(buffer:Pchar; size:PtrInt; nitems:PtrInt;
+ appender: PString): PtrInt; cdecl;
+begin
+ assert(appender <> nil);
+ result := size* nitems;
+ try
+ (appender^) += buffer;
+ except
+ result := 0;
+ end;
+end;
+
+function simpleGet(url: string; var data: string): boolean; overload;
+var
+ c: CURLcode;
+ h: CURL;
+begin
+ h := curlHandle();
+ if not assigned(h) then
+ exit(false);
+ c := curl_easy_setopt(h, CURLOPT_USERAGENT, ['curl-fclweb']);
+ if c <> CURLcode.CURLE_OK then
+ exit(false);
+ c := curl_easy_setopt(h, CURLOPT_URL, [PChar(url)]);
+ if c <> CURLcode.CURLE_OK then
+ exit(false);
+ c := curl_easy_setopt(h, CURLOPT_WRITEDATA, [@data]);
+ if c <> CURLcode.CURLE_OK then
+ exit(false);
+ c := curl_easy_setopt(h, CURLOPT_WRITEFUNCTION, [@simpleGetClbckForString]);
+ if c <> CURLcode.CURLE_OK then
+ exit(false);
+ c := curl_easy_perform(h);
+ result := c = CURLcode.CURLE_OK;
+end;
+
+function simpleGet(url: string; data: TStream): boolean; overload;
+var
+ c: CURLcode;
+ h: CURL;
+begin
+ h := curlHandle();
+ if not assigned(h) then
+ exit(false);
+ c := curl_easy_setopt(h, CURLOPT_USERAGENT, ['curl-fclweb']);
+ if c <> CURLcode.CURLE_OK then
+ exit(false);
+ c := curl_easy_setopt(h, CURLOPT_URL, [PChar(url)]);
+ if c <> CURLcode.CURLE_OK then
+ exit(false);
+ c := curl_easy_setopt(h, CURLOPT_WRITEDATA, [@data]);
+ if c <> CURLcode.CURLE_OK then
+ exit(false);
+ c := curl_easy_setopt(h, CURLOPT_WRITEFUNCTION, [@simpleGetClbckForStream]);
+ if c <> CURLcode.CURLE_OK then
+ exit(false);
+ c := curl_easy_perform(h);
+ result := c = CURLcode.CURLE_OK;
+end;
+
+function simpleGet(url: string; var data: TJSONData): boolean; overload;
+var
+ s: string = '';
+begin
+ if not simpleGet(url, s) then
+ exit(false);
+ result := true;
+ with TJSONParser.Create(s, [joUTF8, joIgnoreTrailingComma]) do
+ try
+ try
+ data := Parse();
+ except
+ result := false;
+ end;
+ finally
+ free;
+ end;
+end;
+
+finalization
+ if assigned(fCurlHandle) then
+ curl_easy_cleanup(fCurlHandle);
+end.
+