fix #209 - Update checker fails with openssl >= 1.1

lazproj/dexed.lpi

@@ -526,7 +526,7 @@
         <PackageName Value="LCL"/>
       </Item8>
     </RequiredPackages>
-    <Units Count="60">
+    <Units Count="61">
       <Unit0>
         <Filename Value="dexed.lpr"/>
         <IsPartOfProject Value="True"/>
@@ -842,6 +842,10 @@
         <ComponentName Value="CeNewDubProject"/>
         <ResourceBaseClass Value="Form"/>
       </Unit59>
+      <Unit60>
+        <Filename Value="..\src\u_simpleget.pas"/>
+        <IsPartOfProject Value="True"/>
+      </Unit60>
     </Units>
   </ProjectOptions>
   <CompilerOptions>

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}
 

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);

src/u_libmaneditor.pas

@@ -6,8 +6,7 @@ interface
 
 uses
   Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, ExtCtrls,
-  Menus, ComCtrls, Buttons, LazFileUtils, fphttpclient, StdCtrls,
+  Menus, ComCtrls, Buttons, LazFileUtils, StdCtrls, fpjson,
-  fpjson, jsonparser,
   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);
+  simpleGet('http://code.dlang.org/api/packages/search', fList);
-  try
+  if assigned(fList) then
-    try
+    fillList
-      //TODO: use HTTPS when FCL-WEB will allow it again.
+  else
-      pge := cli.Get('http://code.dlang.org/api/packages/search');
+    dlgOkError('could not get the package list, check you connection or that curl library is setup');
-    except
-      pge := '[]';
-    end;
-  finally
-    cli.Free;
-  end;
-  prs := TJSONParser.Create(pge, []);
-  try
-    fList := prs.Parse;
-  finally
-    prs.Free;
-  end;
-  fillList;
 end;
 
 procedure TDubPackageQueryForm.fillList;
@@ -386,8 +370,8 @@ var
   jsn: TJSONData;
 begin
   result := 'master';
-  if fGetLatestTag then
+  if not fGetLatestTag then
-  begin
+    exit;
   // list is updated
   if fList.isNotNil and (cbb.ItemIndex <> -1) and
     cbb.Items.Objects[cbb.ItemIndex].isNotNil then
@@ -396,24 +380,15 @@ begin
     jsn := jsn.FindPath('version');
     result := jsn.AsString;
   end
-    else
   // use API
+  else
   begin
-      with TFPHTTPClient.Create(nil) do
+    result := '';
-      try
+    if not simpleGet('http://code.dlang.org/api/packages/' + packageName + '/latest', result) then
-        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;
-  end;
 end;
 
 procedure TDubPackageQueryForm.updateHint(sender: TObject);

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,
+  {$IFDEF WINDOWS}Windows, {$ENDIF} XMLPropStorage, SynExportHTML,
-  fpjson, jsonparser, jsonscanner, LCLIntf,
+  fpjson, jsonscanner, LCLIntf,
-  u_common, u_ceproject, u_synmemo, u_writableComponent,
+  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 simpleGet(updURL, dat) then
-  if openssl.IsSSLloaded 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
-      end;
+        else
+          dlgOkInfo('No new release available');
       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
+  end;
-  else dlgOkInfo('No new release available or no connectivity');
 end;
 
 procedure TMainForm.mnuItemManualClick(Sender: TObject);

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.
+