spiegel-keyman/developer/src/tike/dialogs/Keyman.Developer.UI.UfrmServerOptions.pas

unit Keyman.Developer.UI.UfrmServerOptions;

interface

uses
  System.Classes,
  System.Net.HttpClient,
  System.SysUtils,
  System.Variants,
  System.Win.Registry,
  Vcl.Controls,
  Vcl.Dialogs,
  Vcl.Forms,
  Vcl.Graphics,
  Vcl.StdCtrls,
  Winapi.Messages,
  Winapi.Windows,

  UfrmDownloadProgress,
  UfrmTike;

type
  TfrmServerOptions = class(TTikeForm)
    cmdOK: TButton;
    cmdCancel: TButton;
    gbSetup: TGroupBox;
    editAuthToken: TEdit;
    lblAuthToken: TLabel;
    cmdDownload: TButton;
    gbAdvanced: TGroupBox;
    chkServerShowConsoleWindow: TCheckBox;
    cmdCreateAccount: TButton;
    lblNgrokInstallState: TLabel;
    Label1: TLabel;
    lblGetToken: TLabel;
    lblDefaultPort: TLabel;
    editDefaultPort: TEdit;
    chkUseNgrok: TCheckBox;
    chkLeaveServerRunning: TCheckBox;
    cmdInstallVCRedist: TButton;
    lblVCRedistInstallState: TLabel;
    procedure FormCreate(Sender: TObject);
    procedure cmdOKClick(Sender: TObject);
    procedure cmdDownloadClick(Sender: TObject);
    procedure cmdCreateAccountClick(Sender: TObject);
    procedure lblGetTokenClick(Sender: TObject);
    procedure cmdInstallVCRedistClick(Sender: TObject);
  private
    FInstallStateChanged: Boolean;
    FDownloadProgress: TfrmDownloadProgress;
    FDownloadObject: string;
    procedure UpdateVersionLabel;
    function NgrokPath: string;
    procedure DownloadNgrok(AOwner: TfrmDownloadProgress; var Result: Boolean);
    procedure HttpReceiveData(const Sender: TObject; AContentLength,
      AReadCount: Int64; var Abort: Boolean);
    procedure DownloadVCRedist(AOwner: TfrmDownloadProgress;
      var Result: Boolean);
    function DoDownload(AOwner: TfrmDownloadProgress; const objectName, url: string): IHTTPResponse;
    function RedistInstallerPath: string;
  public
  end;

implementation

uses
  Winapi.ShlObj,

  KeymanDeveloperOptions,
  Keyman.Developer.System.ServerAPI,
  KeymanPaths,
  RegistryKeys,
  UmodWebHttpServer,
  utilexecute;

{$R *.dfm}

const
  // These URLs come from ngrok documentation and ngrok source. They appear
  // to be stable, as they are used in other apps also.
  SUrlNgrokAuthToken = 'https://dashboard.ngrok.com/get-started/your-authtoken';
  SUrlNgrokSignup = 'https://dashboard.ngrok.com/signup';

  // Note, we manually update the version of ngrok as required in subsequent
  // releases, rather than trying to handle a potentially moving target. This
  // should match developer/src/server/package.json version for ngrok.
  SNgrokVersion = 'v1.7.0';
  SUrlNgrokDownload = 'https://github.com/ngrok/ngrok-javascript/releases/download/'+SNgrokVersion+'/ngrok.win32-ia32-msvc.node';
  SNgrokNodeModuleFilename = 'ngrok-win32-ia32-msvc.node';

  // VC++ Redistributable - presence, filename, and permanent URL
  SUrlVCRedistDownload = 'https://aka.ms/vc14/vc_redist.x86.exe';
  SVCRedistExeFilename = 'VC_redist.x86.exe';
  SRegKey_VCRedist = 'SOFTWARE\Microsoft\VisualStudio\14.0\VC\Runtimes\x86';
  SRegValue_VCRedist_Version = 'Version';

procedure TfrmServerOptions.cmdCreateAccountClick(Sender: TObject);
begin
  TUtilExecute.URL(SUrlNgrokSignup);
end;

procedure TfrmServerOptions.HttpReceiveData(const Sender: TObject; AContentLength: Int64; AReadCount: Int64; var Abort: Boolean);
begin
  Abort := False;
  if Assigned(FDownloadProgress) then
  begin
    FDownloadProgress.HTTPStatus(nil, 'Downloading '+FDownloadObject, AReadCount, AContentLength);
    FDownloadProgress.HTTPCheckCancel(nil, Abort);
  end;
end;

function TfrmServerOptions.DoDownload(AOwner: TfrmDownloadProgress; const objectName, url: string): IHTTPResponse;
var
  http: THttpClient;
  res: IHTTPResponse;
begin
  Result := nil;

  FDownloadObject := objectName;
  FDownloadProgress := AOwner;
  http := THttpClient.Create;
  try
    http.OnReceiveData := HttpReceiveData;

    try
      res := http.Get(url);
    except
      on E:ENetHTTPClientException do
      begin
        ShowMessage(Format('Unable to download %s from %s: %s', [objectName, url, E.Message]));
        Exit;
      end;
    end;

    if res.StatusCode <> 200 then
    begin
      ShowMessage(Format('Unable to download %s from %s: %d %s',
        [objectName, url, res.StatusCode, res.StatusText]));
      Exit;
    end;

    Result := res;
  finally
    http.Free;
    FDownloadProgress := nil;
    FDownloadObject := '';
  end;
end;

procedure TfrmServerOptions.DownloadVCRedist(AOwner: TfrmDownloadProgress; var Result: Boolean);
var
  res: IHTTPResponse;
  fs: TFileStream;
begin
  Result := False;

  res := DoDownload(AOwner, 'Microsoft Visual C++ Redistributable', SUrlVCRedistDownload);
  if not Assigned(res) then
    Exit;

  // Save the redistributable installer

  try
    fs := TFileStream.Create(RedistInstallerPath, fmCreate);
    try
      fs.CopyFrom(res.ContentStream, 0);
    finally
      fs.Free;
    end;
  except
    on E:Exception do
    begin
      ShowMessage(Format('Unable to save %s: %s', [RedistInstallerPath, E.Message]));
      Exit;
    end;
  end;

  // Execute the installer - user will need to follow prompts to complete installation

  Result := TUtilExecute.WaitForProcess('"'+RedistInstallerPath+'"', ExtractFileDir(RedistInstallerPath), SW_SHOWNORMAL);
  FInstallStateChanged := True;
end;

procedure TfrmServerOptions.DownloadNgrok(AOwner: TfrmDownloadProgress; var Result: Boolean);
var
  res: IHTTPResponse;
  fs: TFileStream;
begin
  Result := False;

  res := DoDownload(AOwner, 'ngrok', SUrlNgrokDownload);
  if not Assigned(res) then
    Exit;

  // Download is a single file, needs to be saved to AppData\Keyman\Keyman Developer\Server\bin\@ngrok\filename

  try
    fs := TFileStream.Create(NgrokPath, fmCreate);
  except
    on E:Exception do
    begin
      ShowMessage(Format('Unable to save %s: %s', [SNgrokNodeModuleFilename, E.Message]));
      Exit;
    end;
  end;
  try
    fs.CopyFrom(res.ContentStream, 0);
  finally
    fs.Free;
  end;

  Result := True;
  FInstallStateChanged := True;
end;

procedure TfrmServerOptions.cmdDownloadClick(Sender: TObject);
var
  DownloadProgress: TfrmDownloadProgress;
begin
  if FKeymanDeveloperOptions.ServerUseNgrok then
  begin
    // We need to stop the server if NGrok has been enabled because the module
    // may be locked and in use
    TServerDebugAPI.StopServer;
  end;

  DownloadProgress := TfrmDownloadProgress.Create(Self);
  try
    DownloadProgress.Callback := DownloadNgrok;
    DownloadProgress.ShowModal;
  finally
    DownloadProgress.Free;
    UpdateVersionLabel;
    if FKeymanDeveloperOptions.ServerUseNgrok then
    begin
      // Restart the server after ngrok module is installed (although ngrok may
      // not run if the dependency is not also installed)
      TServerDebugAPI.StartServer;
    end;
  end;
end;

procedure TfrmServerOptions.cmdInstallVCRedistClick(Sender: TObject);
var
  DownloadProgress: TfrmDownloadProgress;
begin
  DownloadProgress := TfrmDownloadProgress.Create(Self);
  try
    DownloadProgress.Callback := DownloadVCRedist;
    DownloadProgress.ShowModal;
  finally
    DownloadProgress.Free;
    UpdateVersionLabel;
  end;
end;

procedure TfrmServerOptions.cmdOKClick(Sender: TObject);
var
  DefaultPort: Integer;
  KeepAlive, UseNgrok, ngrokKeepVisible: Boolean;
  ngrokToken: string;
  Changed: Boolean;
begin
  DefaultPort := StrToIntDef(editDefaultPort.Text, 8008);   // I4021
  KeepAlive := chkLeaveServerRunning.Checked;
  UseNgrok := chkUseNgrok.Checked;
  ngrokToken := editAuthToken.Text;
  ngrokKeepVisible := chkServerShowConsoleWindow.Checked;

  Changed :=
    (FKeymanDeveloperOptions.ServerDefaultPort <> DefaultPort) or
    (FKeymanDeveloperOptions.ServerKeepAlive <> KeepAlive) or
    (FKeymanDeveloperOptions.ServerUseNgrok <> UseNgrok) or
    (FKeymanDeveloperOptions.ServerNgrokToken <> ngrokToken) or
    (FKeymanDeveloperOptions.ServerServerShowConsoleWindow <> ngrokKeepVisible) or
    FInstallStateChanged;

  if Changed then
  begin
    FKeymanDeveloperOptions.ServerDefaultPort := DefaultPort;
    FKeymanDeveloperOptions.ServerKeepAlive := KeepAlive;
    FKeymanDeveloperOptions.ServerUseNgrok := UseNgrok;
    FKeymanDeveloperOptions.ServerNgrokToken := ngrokToken;
    FKeymanDeveloperOptions.ServerServerShowConsoleWindow := ngrokKeepVisible;
    FKeymanDeveloperOptions.Write; // TODO: Cancel button in parent dialog is a problem
    modWebHttpServer.RestartServer;
  end;
  ModalResult := mrOk;
end;

procedure TfrmServerOptions.FormCreate(Sender: TObject);
begin
  editDefaultPort.Text := IntToStr(FKeymanDeveloperOptions.ServerDefaultPort);   // I4021
  chkUseNgrok.Checked := FKeymanDeveloperOptions.ServerUseNgrok;
  chkLeaveServerRunning.Checked := FKeymanDeveloperOptions.ServerKeepAlive;

  lblNgrokInstallState.Caption := '';
  lblVCRedistInstallState.Caption := '';
  editAuthToken.Text := FKeymanDeveloperOptions.ServerNgrokToken;

  chkServerShowConsoleWindow.Checked := FKeymanDeveloperOptions.ServerServerShowConsoleWindow;

  UpdateVersionLabel;
end;

procedure TfrmServerOptions.lblGetTokenClick(Sender: TObject);
begin
  TUtilExecute.URL(SUrlNgrokAuthToken);
end;


function TfrmServerOptions.NgrokPath: string;
begin
  Result := TServerDebugAPI.ServerBinPath + '\@ngrok';
  ForceDirectories(Result);
  Result := Result + '\' + SNgrokNodeModuleFilename;
end;

function TfrmServerOptions.RedistInstallerPath: string;
begin
  Result := TServerDebugAPI.ServerBinPath + '\' + SVCRedistExeFilename;
end;

procedure TfrmServerOptions.UpdateVersionLabel;
var
  reg: TRegistry;
begin
  if FileExists(NgrokPath)
    then lblNgrokInstallState.Caption := 'Installed'
    else lblNgrokInstallState.Caption := 'Not installed';

  lblVCRedistInstallState.Caption := 'Not installed';
  reg := TRegistry.Create;
  try
    reg.RootKey := HKEY_LOCAL_MACHINE;
    if reg.OpenKeyReadOnly(SRegKey_VCRedist) and reg.ValueExists(SRegValue_VCRedist_Version) then
      lblVCRedistInstallState.Caption := reg.ReadString(SRegValue_VCRedist_Version);
  finally
    reg.Free;
  end;
end;

end.