rpc.pas

{*************************************************************************************
  This file is part of Transmission Remote GUI.
  Copyright (c) 2008-2019 by Yury Sidorov and Transmission Remote GUI working group.

  Transmission Remote GUI is free software; you can redistribute it and/or modify
  it under the terms of the GNU General Public License as published by
  the Free Software Foundation; either version 2 of the License, or
  (at your option) any later version.

  Transmission Remote GUI is distributed in the hope that it will be useful,
  but WITHOUT ANY WARRANTY; without even the implied warranty of
  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  GNU General Public License for more details.

  You should have received a copy of the GNU General Public License
  along with Transmission Remote GUI; if not, write to the Free Software
  Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA  02110-1301  USA

  In addition, as a special exception, the copyright holders give permission to 
  link the code of portions of this program with the
  OpenSSL library under certain conditions as described in each individual
  source file, and distribute linked combinations including the two.

  You must obey the GNU General Public License in all respects for all of the
  code used other than OpenSSL.  If you modify file(s) with this exception, you
  may extend this exception to your version of the file(s), but you are not
  obligated to do so.  If you do not wish to do so, delete this exception
  statement from your version.  If you delete this exception statement from all
  source files in the program, then also delete it here.
*************************************************************************************}
unit rpc;

{$mode objfpc}{$H+}

interface

uses
  Classes, SysUtils, Forms, httpsend, syncobjs, fpjson, jsonparser, ssl_openssl,
  ZStream, jsonscanner, Math;

resourcestring
  sTransmissionAt = 'Transmission%s at %s:%s';

const
  DefaultRpcPath = '/transmission/rpc';

type
  TAdvInfoType = (aiNone, aiGeneral, aiFiles, aiPeers, aiTrackers, aiStats);
  TRefreshTypes = (rtTorrents, rtDetails, rtSession);
  TRefreshType = set of TRefreshTypes;

  TRpc = class;

  { TRpcThread }

  TRpcThread = class(TThread)
  private
    ResultData: TJSONData;
    StatsValid: boolean;
    StatsErrorShown: boolean;
    FRpc: TRpc;
    FDetailsGeneration: cardinal;
    FFilePayloadGeneration: cardinal;
    FDetailsTorrentId: cardinal;
    FDetailsAdvInfo: TAdvInfoType;
    FPiecesSkip: integer;
    FStaticInfoId: integer;
    FLastPieces: string;
    FLastPiecesTime: TDateTime;
    FLastHashString: string;
    FLastCreator: string;
    FLastDateCreated: double;

    function GetRefreshInterval: TDateTime;
    function GetStatus: string;
    procedure SetStatus(const AValue: string);

    function GetTorrents: boolean;
    procedure GetPeers(TorrentId: integer);
    procedure GetFiles(TorrentId: integer);
    procedure GetTrackers(TorrentId: integer);
    procedure GetStats;
    procedure GetInfo(TorrentId: integer);
    procedure GetSessionInfo;

    procedure DoFillTorrentsList;
    procedure DoFillPeersList;
    procedure DoFillFilesList;
    procedure DoFillInfo;
    procedure DoFillTrackersList;
    procedure DoFillStats;
    procedure DoFillSessionInfo;
    procedure NotifyStatsError;
    procedure StatsErrorHandler(Data: PtrInt);
    procedure NotifyCheckStatus;
    procedure CheckStatusHandler(Data: PtrInt);
    function IsTerminated: boolean;
  protected
    procedure Execute; override;
  public
    constructor Create;
    destructor Destroy; override;

    property Status: string read GetStatus write SetStatus;
    property RefreshInterval: TDateTime read GetRefreshInterval;
  end;

  TRpc = class
  private
    FLock: TCriticalSection;
    FStatus: string;
    FInfoStatus: string;
    FConnected: boolean;
    FTorrentFields: string;
    FRPCVersion: integer;
    XTorrentSession: string;
    FMainThreadId: TThreadID;
    FRpcPath: string;
    FRefreshGeneration: array[TRefreshTypes] of cardinal;
    FFilePayloadGeneration: cardinal;
    FRefreshNow: TRefreshType;

    function BeginRefresh(ARefresh: TRefreshTypes): cardinal;
    procedure BeginDetailsRequest(out AGeneration, AFileGeneration,
      ATorrentId: cardinal; out AAdvInfo: TAdvInfoType);
    procedure FinishDetailsRequest(AGeneration, ATorrentId: cardinal; AAdvInfo: TAdvInfoType);
    procedure FinishRefresh(ARefresh: TRefreshTypes; AGeneration: cardinal);
    function GetConnected: boolean;
    function GetConnecting: boolean;
    function GetInfoStatus: string;
    function GetStatus: string;
    function GetTorrentFields: string;
    function IsFileDetailsRequestCurrent(AFileGeneration,
      ATorrentId: cardinal): boolean;
    procedure SetInfoStatus(const AValue: string);
    procedure SetStatus(const AValue: string);
    procedure SetTorrentFields(const AValue: string);
    procedure CreateHttp;
    procedure HttpHeartbeat(Sender: TObject);
    procedure HttpSocketCreated(Sender: TObject);
    procedure StopRpcThread;
  public
    Http: THTTPSend;
    HttpLock: TCriticalSection;
    RpcThread: TRpcThread;
    Url: string;
    RefreshInterval: TDateTime;
    CurTorrentId: cardinal;
    AdvInfo: TAdvInfoType;
    RequestFullInfo: boolean;
    ReconnectAllowed: boolean;
    RequestStartTime: TDateTime;

    constructor Create;
    destructor Destroy; override;
    function InitSSL(out ASSLName, AUtilName: string): boolean;

    procedure Lock;
    procedure Unlock;

    procedure Connect;
    procedure Disconnect;
    procedure FileDetailsChanged;
    function RefreshPending: boolean; overload;
    function RefreshPending(ARefresh: TRefreshTypes): boolean; overload;
    procedure RequestRefresh(const ARefresh: TRefreshType);
    procedure SetAdvancedInfo(AAdvInfo: TAdvInfoType; ARefresh: boolean);

    function SendRequest(req: TJSONObject; ReturnArguments: boolean = True;
      ATimeOut: integer = -1): TJSONObject; overload;
    function SendRequest(req: TJSONObject; ReturnArguments: boolean;
      ATimeOut: integer; out AResponseError: string): TJSONObject; overload;
    function RequestInfo(TorrentId: integer; const Fields: array of const; const ExtraFields: array of string): TJSONObject;
    function RequestInfo(TorrentId: integer; const Fields: array of const): TJSONObject;

    property Status: string read GetStatus write SetStatus;
    property InfoStatus: string read GetInfoStatus write SetInfoStatus;
    property Connected: boolean read GetConnected;
    property Connecting: boolean read GetConnecting;
    property TorrentFields: string read GetTorrentFields write SetTorrentFields;
    property RPCVersion: integer read FRPCVersion;
    property RpcPath: string read FRpcPath write FRpcPath;
  end;

var
  RemotePathDelimiter: char = '/';

function EnsureOpenSSLLoaded(out ASSLName, AUtilName: string): boolean;

implementation

uses Main, ssl_openssl_lib, synafpc, blcksock;

var
  OpenSSLInitLock: TCriticalSection;

function EnsureOpenSSLLoaded(out ASSLName, AUtilName: string): boolean;
{$ifdef unix}
{$ifndef darwin}
  procedure CheckOpenSSL;
  const
  OpenSSLVersions: array[1..6] of string =
  ('3', '1.1', '1.1.0', '1.0.2', '1.0.0', '0.9.8');
  var
    hLib1, hLib2: TLibHandle;
    i: integer;
  begin
    for i:=Low(OpenSSLVersions) to High(OpenSSLVersions) do begin
      hlib1:=LoadLibrary(PChar('libssl.so.' + OpenSSLVersions[i]));
      hlib2:=LoadLibrary(PChar('libcrypto.so.' + OpenSSLVersions[i]));
      if hLib2 <> 0 then
        FreeLibrary(hLib2);
      if hLib1 <> 0 then
        FreeLibrary(hLib1);
      if (hLib1 <> 0) and (hLib2 <> 0) then begin
        DLLSSLName:='libssl.so.' + OpenSSLVersions[i];
        DLLUtilName:='libcrypto.so.' + OpenSSLVersions[i];
        break;
      end;
    end;
  end;
{$endif darwin}
{$endif unix}
begin
  OpenSSLInitLock.Enter;
  try
    if not IsSSLloaded then begin
{$ifdef unix}
{$ifndef darwin}
      CheckOpenSSL;
{$endif darwin}
{$endif unix}
      InitSSLInterface;
    end;
    Result:=IsSSLloaded;
    ASSLName:=DLLSSLName;
    AUtilName:=DLLUtilName;
  finally
    OpenSSLInitLock.Leave;
  end;
end;

function TranslateTableToObjects(reply: TJSONObject) : TJSONObject;
var
  array_tor, fields, out_torrents : TJSONArray;
  object_tor : TJSONObject;
  i, j : integer;
begin
  fields:=reply.Arrays['torrents'].Arrays[0];
  out_torrents:=TJSONArray.Create;
  for i:=1 to reply.Arrays['torrents'].Count - 1 do
  begin
    array_tor:=reply.Arrays['torrents'].Arrays[i];
    object_tor:=TJSONObject.Create;
    for j:=0 to fields.Count - 1 do
      object_tor.Add(fields.Items[j].AsString, array_tor.Items[j].Clone);

    out_torrents.Add(object_tor);
  end;
  Result:=TJSONObject.Create(['torrents', out_torrents]);
  reply.Free;
end;

{ TRpcThread }

procedure TRpcThread.Execute;
var
  t, tt: TDateTime;
  i: integer;
  generation: cardinal;
  ai: TAdvInfoType;
begin
  try
    GetSessionInfo;
    NotifyCheckStatus;
    if not FRpc.FConnected then
      Terminate;

    t:=Now - 1;
    tt:=Now;
    while not Terminated do begin
      if Now - t >= RefreshInterval then begin
        FRpc.RequestRefresh([rtTorrents, rtDetails]);
        t:=Now;
      end;
      if Now - tt >= RefreshInterval*5 then begin
        FRpc.RequestRefresh([rtSession]);
        tt:=Now;
      end;

      if Status = '' then
        if FRpc.RefreshPending(rtTorrents) then begin
          generation:=FRpc.BeginRefresh(rtTorrents);
          GetTorrents;
          FRpc.FinishRefresh(rtTorrents, generation);
          t:=Now;
        end
        else
          if FRpc.RefreshPending(rtDetails) then begin
            FRpc.BeginDetailsRequest(FDetailsGeneration, FFilePayloadGeneration,
              FDetailsTorrentId, FDetailsAdvInfo);
            i:=FDetailsTorrentId;
            ai:=FDetailsAdvInfo;
            if i <> 0 then begin
              case ai of
                aiGeneral:
                  GetInfo(i);
                aiPeers:
                  GetPeers(i);
                aiFiles:
                  GetFiles(i);
                aiTrackers:
                  GetTrackers(i);
              end;
            end;

            case ai of
              aiStats:
                GetStats;
            end;

            FRpc.FinishDetailsRequest(FDetailsGeneration, FDetailsTorrentId, FDetailsAdvInfo);
          end
          else
            if FRpc.RefreshPending(rtSession) then begin
              generation:=FRpc.BeginRefresh(rtSession);
              GetSessionInfo;
              FRpc.FinishRefresh(rtSession, generation);
            end;

      if Status <> '' then begin
        NotifyCheckStatus;
        Sleep(100);
      end;

      if not FRpc.RefreshPending then
        Sleep(50);
    end;
  except
    Status:=Exception(ExceptObject).Message;
    NotifyCheckStatus;
  end;
  FRpc.FConnected:=False;
  FRpc.FRPCVersion:=0;
end;

constructor TRpcThread.Create;
begin
  inherited Create(True);
  FPiecesSkip := 0;
  FStaticInfoId := -1;
  FLastPiecesTime := 0;
  FLastDateCreated := 0;
end;

destructor TRpcThread.Destroy;
begin
  Application.RemoveAsyncCalls(Self);
  inherited Destroy;
end;

function TRpcThread.IsTerminated: boolean;
begin
  Result:=Terminated;
end;

procedure TRpcThread.SetStatus(const AValue: string);
begin
  FRpc.Status:=AValue;
end;

procedure TRpcThread.DoFillTorrentsList;
begin
  MainForm.FillTorrentsList(ResultData as TJSONArray);
end;

procedure TRpcThread.DoFillPeersList;
begin
  MainForm.FillPeersList(ResultData as TJSONArray);
end;

procedure TRpcThread.DoFillFilesList;
var
  t: TJSONObject;
  dir: widestring;
begin
  if Terminated or (csDestroying in MainForm.ComponentState) or
     not FRpc.IsFileDetailsRequestCurrent(FFilePayloadGeneration,
       FDetailsTorrentId) then
    exit;
  if ResultData = nil then begin
    MainForm.ClearDetailsInfo;
    exit;
  end;
  t:=ResultData as TJSONObject;
  if RpcObj.RPCVersion >= 4 then
    dir:=widestring(t.Strings['downloadDir'])
  else
    dir:='';
  MainForm.FillFilesList(t.Integers['id'], t.Arrays['files'], t.Arrays['priorities'], t.Arrays['wanted'], dir);
end;

procedure TRpcThread.DoFillInfo;
begin
  MainForm.FillGeneralInfo(ResultData as TJSONObject);
end;

procedure TRpcThread.DoFillTrackersList;
begin
  MainForm.FillTrackersList(ResultData as TJSONObject);
end;

procedure TRpcThread.DoFillStats;
begin
  if Terminated or (csDestroying in MainForm.ComponentState) then
    exit;
  if ResultData = nil then
    StatsValid:=MainForm.FillStatistics(nil)
  else
    StatsValid:=MainForm.FillStatistics(ResultData as TJSONObject);
end;

procedure TRpcThread.DoFillSessionInfo;
begin
  MainForm.FillSessionInfo(ResultData as TJSONObject);
end;

procedure TRpcThread.NotifyCheckStatus;
begin
  if not Terminated then
    Application.QueueAsyncCall(@CheckStatusHandler, 0);
end;

procedure TRpcThread.NotifyStatsError;
begin
  if not Terminated then
    Application.QueueAsyncCall(@StatsErrorHandler, 0);
end;

procedure TRpcThread.StatsErrorHandler(Data: PtrInt);
begin
  if Terminated or (csDestroying in MainForm.ComponentState) then exit;
  MainForm.CheckStatus(False, 'Invalid server response.');
end;

procedure TRpcThread.CheckStatusHandler(Data: PtrInt);
begin
  if csDestroying in MainForm.ComponentState then exit;
  MainForm.CheckStatus;
end;

procedure TRpcThread.GetSessionInfo;
var
  req, args, args2: TJSONObject;
  s: string;
begin
  req:=TJSONObject.Create;
  try
    req.Add('method', 'session-get');
    args:=FRpc.SendRequest(req);
    if args <> nil then
    try
      FRpc.FConnected:=True;
      if args.IndexOfName('rpc-version') >= 0 then
        FRpc.FRPCVersion := args.Integers['rpc-version']
      else
        FRpc.FRPCVersion := 0;
      if args.IndexOfName('version') >= 0 then
        s:=' ' + args.Strings['version']
      else
        s:='';
      FRpc.InfoStatus:=Format(sTransmissionAt, [s, FRpc.Http.TargetHost, FRpc.Http.TargetPort]);
      if FRpc.RPCVersion >= 15 then begin
        // Requesting free space in download dir
        req.Free;
        req:=TJSONObject.Create;
        req.Add('method', 'free-space');
        args2:=TJSONObject.Create;
        try
          args2.Add('path', args.Strings['download-dir']);
          req.Add('arguments', args2);
          args2:=FRpc.SendRequest(req);
          if args2 <> nil then
            args.Floats['download-dir-free-space']:=args2.Floats['size-bytes']
          else begin
            args.Floats['download-dir-free-space']:=-1;
            FRpc.Status:='';
          end;
        finally
          args2.Free;
        end;
      end;
      ResultData:=args;
      if not Terminated then
        Synchronize(@DoFillSessionInfo);
    finally
      args.Free;
    end
    else
      ASSERT(FRpc.Status <> '');
  finally
    req.Free;
  end;
end;

function TRpcThread.GetTorrents: boolean;
var
  args: TJSONObject;
  ExtraFields: array of string;
  sl: TStringList;
  i: integer;
begin
  Result:=False;
  sl:=TStringList.Create;
  try
    FRpc.Lock;
    try
      sl.CommaText:=FRpc.FTorrentFields;
    finally
      FRpc.Unlock;
    end;

    if FRpc.RPCVersion < 7 then begin
      i:=sl.IndexOf('trackers');
      if FRpc.RequestFullInfo then begin
        if i < 0 then
          sl.Add('trackers');
      end
      else
        if i >= 0 then
          sl.Delete(i);
    end;

    i:=sl.IndexOf('downloadDir');
    if FRpc.RequestFullInfo then begin
      if i < 0 then
        sl.Add('downloadDir');
    end
    else
      if i >= 0 then
        sl.Delete(i);

    SetLength(ExtraFields, sl.Count);
    for i:=0 to sl.Count - 1 do
      ExtraFields[i]:=sl[i];
  finally
    sl.Free;
  end;

  args:=FRpc.RequestInfo(0, ['id', 'name', 'status', 'errorString', 'announceResponse', 'recheckProgress',
                            'sizeWhenDone', 'leftUntilDone', 'rateDownload', 'rateUpload', 'trackerStats',
                            'metadataPercentComplete'], ExtraFields);
  try
    if (args <> nil) and not Terminated then begin
      FRpc.RequestFullInfo:=False;
      ResultData:=args.Arrays['torrents'];
      Synchronize(@DoFillTorrentsList);
      Result:=True;
    end;
  finally
    args.Free;
  end;
end;

procedure TRpcThread.GetPeers(TorrentId: integer);
var
  args: TJSONObject;
  t: TJSONArray;
begin
  args:=FRpc.RequestInfo(TorrentId, ['peers']);
  try
    if args <> nil then begin
      t:=args.Arrays['torrents'];
      if t.Count > 0 then
        ResultData:=t.Objects[0].Arrays['peers']
      else
        ResultData:=nil;
      if not Terminated then
        Synchronize(@DoFillPeersList);
    end;
  finally
    args.Free;
  end;
end;

procedure TRpcThread.GetFiles(TorrentId: integer);
var
  args: TJSONObject;
  t: TJSONArray;
begin
  args:=FRpc.RequestInfo(TorrentId, ['id', 'files','priorities','wanted','downloadDir']);
  try
    if args <> nil then begin
      t:=args.Arrays['torrents'];
      if t.Count > 0 then
        ResultData:=t.Objects[0]
      else
        ResultData:=nil;
      if not Terminated then
        Synchronize(@DoFillFilesList);
    end;
  finally
    args.Free;
  end;
end;

procedure TRpcThread.GetTrackers(TorrentId: integer);
var
  args: TJSONObject;
  t: TJSONArray;
begin
  args:=FRpc.RequestInfo(TorrentId, ['id','trackers','trackerStats', 'nextAnnounceTime']);
  try
    if args <> nil then begin
      t:=args.Arrays['torrents'];
      if t.Count > 0 then
        ResultData:=t.Objects[0]
      else
        ResultData:=nil;
      if not Terminated then
        Synchronize(@DoFillTrackersList);
    end;
  finally
    args.Free;
  end;
end;

procedure TRpcThread.GetStats;
var
  req, response: TJSONObject;
  idx: integer;
  ResponseError: string;
begin
  req:=TJSONObject.Create;
  try
    req.Add('method', 'session-stats');
    response:=FRpc.SendRequest(req, False, -1, ResponseError);
    if (response <> nil) or (ResponseError <> '') then
    try
      StatsValid:=response <> nil;
      if StatsValid then begin
        idx:=response.IndexOfName('arguments');
        StatsValid:=idx >= 0;
        if StatsValid then
          StatsValid:=response.Items[idx] is TJSONObject;
      end;
      if not Terminated then begin
        if StatsValid then
          ResultData:=response.Items[idx]
        else
          ResultData:=nil;
        Synchronize(@DoFillStats);
        if not StatsValid and not StatsErrorShown then begin
          StatsErrorShown:=True;
          NotifyStatsError;
        end;
      end;
    finally
      response.Free;
    end;
  finally
    req.Free;
  end;
end;

procedure TRpcThread.GetInfo(TorrentId: integer);
var
  args: TJSONObject;
  t: TJSONArray;
  to0: TJSONObject;
  ExtraFields: array of string;
  i: integer;
  NeedStatic: boolean;
  NeedPieces: boolean;
  TorrentChanged: boolean;
  MetadataComplete: boolean;

  procedure InjectStr(o: TJSONObject; const AKey, AValue: string);
  begin
    if o.IndexOfName(AKey) < 0 then
      o.Add(AKey, AValue)
    else
      o.Strings[AKey] := AValue;
  end;

begin
  SetLength(ExtraFields, 0);
  TorrentChanged := TorrentId <> FStaticInfoId;
  if TorrentChanged then begin
    // A different torrent is selected: force a fresh fetch of immutable data this round.
    FPiecesSkip := 0;
    FStaticInfoId := -1;
    FLastHashString := '';
    FLastCreator := '';
    FLastDateCreated := 0;
    FLastPieces := '';
    FLastPiecesTime := 0;
    NeedStatic := True;
  end
  else
    NeedStatic := False;

  if FRpc.RPCVersion >= 5 then begin
    // Also refresh immediately after the General tab has been inactive for a full throttle window.
    NeedPieces := (FPiecesSkip <= 0) or (FLastPiecesTime = 0) or
                  (Now - FLastPiecesTime >= RefreshInterval*4);
    if NeedPieces then
      FPiecesSkip := 3
    else
      Dec(FPiecesSkip);
  end
  else
    NeedPieces := False;

  if FRpc.RPCVersion >= 7 then begin
    SetLength(ExtraFields, 2);
    ExtraFields[0] := 'magnetLink';
    ExtraFields[1] := 'metadataPercentComplete';
  end;

  if NeedStatic then begin
    i := Length(ExtraFields);
    SetLength(ExtraFields, i + 3);
    ExtraFields[i]     := 'hashString';
    ExtraFields[i + 1] := 'creator';
    ExtraFields[i + 2] := 'dateCreated';
  end;

  if NeedPieces then begin
    i := Length(ExtraFields);
    SetLength(ExtraFields, i + 1);
    ExtraFields[i] := 'pieces';
  end;

  args:=FRpc.RequestInfo(TorrentId, ['totalSize', 'sizeWhenDone', 'leftUntilDone', 'pieceCount', 'pieceSize', 'haveValid',
                                    'comment', 'downloadedEver', 'uploadedEver', 'corruptEver', 'errorString',
                                    'announceResponse', 'downloadLimit', 'downloadLimitMode', 'uploadLimit', 'uploadLimitMode',
                                    'maxConnectedPeers', 'nextAnnounceTime', 'eta', 'peersSendingToUs',
                                    'seeders','peersGettingFromUs','leechers', 'uploadRatio', 'addedDate', 'doneDate',
                                    'activityDate', 'downloadLimited', 'uploadLimited', 'downloadDir', 'id',
                                    'trackerStats', 'secondsDownloading', 'secondsSeeding', 'isPrivate', 'labels'], ExtraFields);
  try
    if args <> nil then begin
      t:=args.Arrays['torrents'];
      if t.Count > 0 then
        to0:=t.Objects[0]
      else
        to0:=nil;
      ResultData:=to0;
      if not Terminated then begin
        if to0 <> nil then begin
          MetadataComplete := (to0.IndexOfName('metadataPercentComplete') < 0) or
                              (to0.Floats['metadataPercentComplete'] >= 1.0);
          // For metadata-incomplete magnets, creator/dateCreated (and pieces) are still empty.
          // Keep refreshing them until metadata arrives instead of caching blank/zero values.
          if not MetadataComplete then begin
            FStaticInfoId := -1;
            FPiecesSkip := 0;
            FLastPiecesTime := 0;
          end;
          if NeedPieces then begin
            // Freshly fetched: cache the large bitfield for throttled refreshes.
            FLastPieces := to0.Strings['pieces'];
            FLastPiecesTime := Now;
          end
          else
            if FRpc.RPCVersion >= 5 then
              // Throttled: reuse the last known value so the UI is completely unchanged.
              InjectStr(to0, 'pieces', FLastPieces);
          if NeedStatic then begin
            FLastHashString := to0.Strings['hashString'];
            FLastCreator := to0.Strings['creator'];
            FLastDateCreated := to0.Floats['dateCreated'];
            if MetadataComplete then
              FStaticInfoId := TorrentId;
          end
          else begin
            InjectStr(to0, 'hashString', FLastHashString);
            InjectStr(to0, 'creator', FLastCreator);
            to0.Floats['dateCreated'] := FLastDateCreated;
          end;
        end
        else begin
          // The selected torrent disappeared before this response; do not retain an empty cache.
          FStaticInfoId := -1;
          FPiecesSkip := 0;
          FLastPieces := '';
          FLastHashString := '';
          FLastCreator := '';
          FLastDateCreated := 0;
          FLastPiecesTime := 0;
        end;
        Synchronize(@DoFillInfo);
      end;
    end;
  finally
    args.Free;
  end;
end;

function TRpcThread.GetRefreshInterval: TDateTime;
begin
  FRpc.Lock;
  try
    Result:=FRpc.RefreshInterval;
  finally
    FRpc.Unlock;
  end;
end;

function TRpcThread.GetStatus: string;
begin
  Result:=FRpc.Status;
end;

{ TRpc }

constructor TRpc.Create;
begin
  inherited;
  FMainThreadId:=GetCurrentThreadId;
  FLock:=TCriticalSection.Create;
  HttpLock:=TCriticalSection.Create;
  FRefreshNow:=[];
  CreateHttp;
end;

destructor TRpc.Destroy;
begin
  Disconnect;
  Http.Free;
  HttpLock.Free;
  FLock.Free;
  inherited Destroy;
end;

function TRpc.InitSSL(out ASSLName, AUtilName: string): boolean;
begin
  Result:=EnsureOpenSSLLoaded(ASSLName, AUtilName);
end;

type TGzipDecompressionStream=class(TDecompressionStream)
public
  constructor create(Asource:TStream);
end;

constructor TGzipDecompressionStream.create(Asource:TStream);
var gzHeader:array[1..10] of byte;
begin
  {
    paszlib is based on a relatively old zlib version that didn't implement
    reading the gzip header. we "implement" this ourselves by skipping the first
    10 bytes which is just enough for the data Transmission sends.
  }
  inherited create(Asource, True);
  Asource.Read(gzHeader,sizeof(gzHeader));
end;

function DecompressGzipContent(source: TStream): TMemoryStream;
var
  buf : array[1..16384] of byte;
  numRead : integer;
  decomp : TGzipDecompressionStream;
begin
  decomp:=TGzipDecompressionStream.create(source);
  try
    Result:=TMemoryStream.create;
    try
      repeat
        numRead:=decomp.read(buf,sizeof(buf));
        Result.Write(buf,numRead);
      until numRead < sizeof(buf);
      Result.Position:=0;
    except
      FreeAndNil(Result);
      raise;
    end;
  finally
    decomp.Free;
  end;
end;

function CreateJsonParser(serverResp : THTTPSend): TJSONParser;
var decompressed : TMemoryStream;
begin
  if serverResp.Headers.IndexOf('Content-Encoding: gzip') <> -1 then
  begin
    { need to fully decompress as the parser relies on a working Seek() }
    decompressed:=DecompressGzipContent(serverResp.Document);
    try
      Result:=TJSONParser.Create(decompressed, [joUTF8]);
    finally
      decompressed.Free;
    end;
  end
  else
  begin
    Result:=TJSONParser.Create(serverResp.Document, [joUTF8]);
  end;
end;

function TRpc.SendRequest(req: TJSONObject; ReturnArguments: boolean;
  ATimeOut: integer): TJSONObject;
var
  ResponseError: string;
begin
  Result:=SendRequest(req, ReturnArguments, ATimeOut, ResponseError);
  if ResponseError <> '' then
    Status:=ResponseError;
end;

function TRpc.SendRequest(req: TJSONObject; ReturnArguments: boolean;
  ATimeOut: integer; out AResponseError: string): TJSONObject;

  procedure StripHtmlTags(var AText: string);
  var
    ReadPos, WritePos: integer;
  begin
    ReadPos:=1;
    WritePos:=1;
    while ReadPos <= Length(AText) do begin
      if AText[ReadPos] = '<' then begin
        Inc(ReadPos);
        while (ReadPos <= Length(AText)) and (AText[ReadPos] <> '>') do
          Inc(ReadPos);
        if ReadPos <= Length(AText) then
          Inc(ReadPos);
      end
      else begin
        AText[WritePos]:=AText[ReadPos];
        Inc(WritePos);
        Inc(ReadPos);
      end;
    end;
    SetLength(AText, WritePos - 1);
  end;

  procedure SetResponseError(const AMessage: string);
  begin
    AResponseError:=AMessage;
    if AResponseError = '' then
      AResponseError:='Invalid server response.';
  end;

var
  obj: TJSONData;
  res: TJSONObject;
  jp: TJSONParser;
  s: string;
  i, j, OldTimeOut, OldDataTimeOut, OldNonblockSendTimeOut, RetryCnt: integer;
  locked, r: boolean;
begin
  AResponseError:='';
  if FRpcPath = '' then
    FRpcPath:=DefaultRpcPath;
  Status:='';
  Result:=nil;
  RetryCnt:=2;
  i:=0;
  repeat
    Inc(i);
    HttpLock.Enter;
    locked:=True;
    try
      OldTimeOut:=Http.Timeout;
      OldDataTimeOut:=Http.Sock.SSL.DataTimeout;
      OldNonblockSendTimeOut:=Http.Sock.NonblockSendTimeout;
      RequestStartTime:=Now;
      Http.Document.Clear;
      s:=req.AsJSON;
      Http.Document.Write(PChar(s)^, Length(s));
      s:='';
      Http.Headers.Clear;
      Http.Headers.Add('Accept-Encoding: gzip');
      Http.MimeType:='application/json';
      if XTorrentSession <> '' then
        Http.Headers.Add(XTorrentSession);
      if ATimeOut >= 0 then begin
        Http.Timeout:=ATimeOut;
        Http.Sock.SSL.DataTimeout:=ATimeOut;
        Http.Sock.NonblockSendTimeout:=ATimeOut;
      end;
      try
        r:=Http.HTTPMethod('POST', Url + FRpcPath);
      finally
        Http.Timeout:=OldTimeOut;
        Http.Sock.SSL.DataTimeout:=OldDataTimeOut;
        Http.Sock.NonblockSendTimeout:=OldNonblockSendTimeOut;
      end;
      if not r then begin
        if FMainThreadId <> GetCurrentThreadId then
          ReconnectAllowed:=True;
        Status:=Http.Sock.LastErrorDesc;
        if not (Http.Sock.SSL is TSSLNone) then
          Http.Sock.SSL.Shutdown;
        Http.Sock.AbortSocket;
        break;
      end
      else begin
        if Http.ResultCode = 409 then begin
          XTorrentSession:='';
          for j:=0 to Http.Headers.Count - 1 do
            if Pos('x-transmission-session-id:', AnsiLowerCase(Http.Headers[j])) > 0 then begin
              XTorrentSession:=Http.Headers[j];
              break;
            end;
          if XTorrentSession <> '' then begin
            if i = RetryCnt then begin
              if FMainThreadId <> GetCurrentThreadId then
                ReconnectAllowed:=True;
              Status:='Session ID error.';
            end;
            continue;
          end;
        end;

        if Http.ResultCode = 301 then begin
          s:=Trim(Http.Headers.Values['Location']);
          if (s <> '') and (Copy(s, 1, 1) = '/') and (Copy(s, 1, 2) <> '//') and (i = 1) then begin
            j:=Length(s);
            if Copy(s, j - 4, MaxInt) = '/web/' then
              SetLength(s, j - 4)
            else
              if Copy(s, j - 3, MaxInt) = '/web' then
                SetLength(s, j - 3);
            FRpcPath:=s + 'rpc';
            Inc(RetryCnt);
            continue;
          end;
        end;

        if Http.ResultCode <> 200 then begin
          if Http.Headers.Count > 0 then begin
            SetString(s, Http.Document.Memory, Http.Document.Size);
            j:=Pos('<body>', LowerCase(s));
            if j > 0 then
              System.Delete(s, 1, j - 1);
            s:=StringReplace(s, #13#10, '', [rfReplaceAll]);
            s:=StringReplace(s, #13, '', [rfReplaceAll]);
            s:=StringReplace(s, #10, '', [rfReplaceAll]);
            s:=StringReplace(s, #9, ' ', [rfReplaceAll]);
            s:=StringReplace(s, '&quot;', '"', [rfReplaceAll, rfIgnoreCase]);
            s:=StringReplace(s, '<br>', LineEnding, [rfReplaceAll, rfIgnoreCase]);
            s:=StringReplace(s, '</p>', LineEnding, [rfReplaceAll, rfIgnoreCase]);
            s:=StringReplace(s, '</h1>', LineEnding, [rfReplaceAll, rfIgnoreCase]);
            s:=StringReplace(s, '<li>', LineEnding+'* ', [rfReplaceAll, rfIgnoreCase]);
            StripHtmlTags(s);
            while Pos('  ', s) > 0 do
              s:=StringReplace(s, '  ', ' ', [rfReplaceAll]);
            while Pos(LineEnding + ' ', s) > 0 do
              s:=StringReplace(s, LineEnding + ' ', LineEnding, [rfReplaceAll]);
            s:=Trim(s);
          end
          else
            s:='';
          if s = '' then begin
            s:=Http.ResultString;
            if s = '' then
              if Http.ResultCode = 0 then
                s:='Invalid server response.'
              else
                s:=Format('HTTP error: %d', [Http.ResultCode]);
          end;
          Status:=s;
          break;
        end;
        Http.Document.Position:=0;
        obj:=nil;
        jp:=nil;
        try
          try
            ClearExceptions(False);
            jp:=CreateJsonParser(Http);
            { Clear under HttpLock before another request can reuse the shared
              HTTP document buffer; the parser has read all response data it
              needs. }
            Http.Document.Clear;
            HttpLock.Leave;
            locked:=False;
            RequestStartTime:=0;
            obj:=jp.Parse;
            { Surface delayed floating-point errors from JSON number parsing
              while they can still be reported as an RPC error. }
            ClearExceptions;
          finally
            jp.Free;
          end;
        except
          on E: Exception do
            begin
              FreeAndNil(obj);
              ClearExceptions(False);
              SetResponseError(e.Message);
              break;
            end;
        end;
        try
          if obj is TJSONObject then begin
            res:=obj as TJSONObject;
            j:=res.IndexOfName('result');
            if j < 0 then begin
              SetResponseError('Invalid server response.');
              break;
            end;
            if res.Items[j].JSONType <> jtString then begin
              SetResponseError('Invalid server response.');
              break;
            end;
            s:=res.Items[j].AsString;
            if AnsiCompareText(s, 'success') <> 0 then begin
              if Trim(s) = '' then
                s:='Unknown error.';
              Status:=s;
            end
            else begin
              if ReturnArguments then begin
                j:=res.IndexOfName('arguments');
                if j < 0 then
                  SetResponseError('Arguments object not found.')
                else if not (res.Items[j] is TJSONObject) then
                  SetResponseError('Arguments object not found.')
                else begin
                  Result:=res.Items[j] as TJSONObject;
//                res.Extract(Result); // lazarus 1.2.6 ok
                  res.Extract(j); // fix Tample :) lazarus 1.4.0 and high!
                  FreeAndNil(obj);
                end;
              end
              else
                Result:=res;
              if Result <> nil then
                obj:=nil;
            end;
            break;
          end
          else begin
            SetResponseError('Invalid server response.');
            break;
          end;
        finally
          obj.Free;
        end;
      end;
    finally
      RequestStartTime:=0;
      if locked then
        HttpLock.Leave;
    end;
  until i >= RetryCnt;
end;

procedure DeleteIfRpcLessThan(Fields: TStringList; Field: string; RpcVer: integer; NeededRpcVer: integer);
var
  idx: integer;
begin
  idx := Fields.IndexOf(Field);
  if (idx <> -1) and (RpcVer < NeededRpcVer) then
    Fields.Delete(idx);
end;

function TRpc.RequestInfo(TorrentId: integer; const Fields: array of const; const ExtraFields: array of string): TJSONObject;
var
  req, args: TJSONObject;
  _fields: TJSONArray;
  i, RequestRpcVersion: integer;
  sl: TStringList;
begin
  Result:=nil;
  RequestRpcVersion:=FRPCVersion;
  req:=TJSONObject.Create;
  sl:=TStringList.Create;
  try
    req.Add('method', 'torrent-get');
    args:=TJSONObject.Create;
    if TorrentId <> 0 then
      args.Add('ids', TJSONArray.Create([TorrentId]));
    _fields:=TJSONArray.Create;
    for i:=Low(Fields) to High(Fields) do
      if (Fields[i].VType=vtAnsiString) then
         sl.Add(String(Fields[i].VAnsiString));
    sl.AddStrings(ExtraFields);
    sl.Sort;

    DeleteIfRpcLessThan(sl, 'labels', RequestRpcVersion, 16);

    for i:=sl.Count-2 downto 0 do
      if (sl[i]=sl[i+1]) then
        sl.Delete(i+1);
    for i:=0 to sl.Count-1 do
      _fields.Add(sl[i]);
    args.Add('fields', _fields);
    if RequestRpcVersion >= 16 then
      args.Add('format', 'table');

    req.Add('arguments', args);
    Result:=SendRequest(req);
    if (RequestRpcVersion >= 16) and (Result <> nil) then
      Result:=TranslateTableToObjects(Result);
  finally
    sl.Free;
    req.Free;
  end;
end;

function TRpc.RequestInfo(TorrentId: integer; const Fields: array of const): TJSONObject;
begin
  Result:=RequestInfo(TorrentId, Fields, []);
end;


function TRpc.GetStatus: string;
begin
  Lock;
  try
    Result:=FStatus;
    UniqueString(Result);
  finally
    Unlock;
  end;
end;

function TRpc.GetTorrentFields: string;
begin
  Lock;
  try
    Result:=FTorrentFields;
    UniqueString(Result);
  finally
    Unlock;
  end;
end;

procedure TRpc.SetInfoStatus(const AValue: string);
begin
  Lock;
  try
    FInfoStatus:=AValue;
    UniqueString(FStatus);
  finally
    Unlock;
  end;
end;

function TRpc.GetConnected: boolean;
begin
  Result:=Assigned(RpcThread) and FConnected;
end;

function TRpc.GetConnecting: boolean;
begin
  Result:=not FConnected and Assigned(RpcThread) and not RpcThread.Finished;
end;

function TRpc.GetInfoStatus: string;
begin
  Lock;
  try
    Result:=FInfoStatus;
    UniqueString(Result);
  finally
    Unlock;
  end;
end;

procedure TRpc.SetStatus(const AValue: string);
begin
  Lock;
  try
    FStatus:=AValue;
    UniqueString(FStatus);
  finally
    Unlock;
  end;
end;

procedure TRpc.SetTorrentFields(const AValue: string);
begin
  Lock;
  try
    FTorrentFields:=AValue;
    UniqueString(FTorrentFields);
  finally
    Unlock;
  end;
end;

procedure TRpc.CreateHttp;
var
  i : integer;
begin
  Http.Free;
  Http:=THTTPSend.Create;
  Http.Protocol:='1.1';
  // Let Abort interrupt blocking socket waits during disconnect.
  Http.Sock.HeartbeatRate:=250;
  Http.Sock.OnHeartbeat:=@HttpHeartbeat;
  Http.Sock.OnCreateSocket:=@HttpSocketCreated;

  i := Ini.ReadInteger('NetWork', 'HttpTimeout', 30);
  if (i < 2) or (i > 999) then i:= 30; // default
  Ini.WriteInteger('NetWork', 'HttpTimeout', i);
  Http.Timeout:= i * 1000;
  Http.Sock.SSL.DataTimeout:=Http.Timeout;
  Http.Sock.NonblockSendTimeout:=Http.Timeout;

  i := Ini.ReadInteger('NetWork', 'ConnectTimeout', 0);
  if (i < 0) or (i > 999) then i:= 0; // default
  Ini.WriteInteger('NetWork', 'ConnectTimeout', i);
  // A positive timeout makes TCP and TLS handshakes cancellable.
  if i = 0 then
    Http.FSock.ConnectionTimeout:=Http.Timeout
  else
    Http.FSock.ConnectionTimeout:=i * 1000;

  Http.Headers.NameValueSeparator:=':';
end;

procedure TRpc.HttpHeartbeat(Sender: TObject);
begin
  if Assigned(RpcThread) and (RpcThread.ThreadID = GetCurrentThreadId) and
     RpcThread.IsTerminated then
    TBlockSocket(Sender).StopFlag:=True;
end;

procedure TRpc.HttpSocketCreated(Sender: TObject);
begin
  TBlockSocket(Sender).NonBlockMode:=True;
end;

procedure TRpc.Lock;
begin
  FLock.Enter;
end;

function TRpc.BeginRefresh(ARefresh: TRefreshTypes): cardinal;
begin
  Lock;
  try
    Result:=FRefreshGeneration[ARefresh];
  finally
    Unlock;
  end;
end;

procedure TRpc.BeginDetailsRequest(out AGeneration, AFileGeneration,
  ATorrentId: cardinal; out AAdvInfo: TAdvInfoType);
begin
  Lock;
  try
    AGeneration:=FRefreshGeneration[rtDetails];
    AFileGeneration:=FFilePayloadGeneration;
    ATorrentId:=CurTorrentId;
    AAdvInfo:=AdvInfo;
  finally
    Unlock;
  end;
end;

function TRpc.IsFileDetailsRequestCurrent(AFileGeneration,
  ATorrentId: cardinal): boolean;
begin
  Lock;
  try
    Result:=(AFileGeneration = FFilePayloadGeneration) and
            (ATorrentId = CurTorrentId) and (AdvInfo = aiFiles);
  finally
    Unlock;
  end;
end;

procedure TRpc.FinishDetailsRequest(AGeneration, ATorrentId: cardinal; AAdvInfo: TAdvInfoType);
begin
  Lock;
  try
    if (AGeneration = FRefreshGeneration[rtDetails]) and
       (ATorrentId = CurTorrentId) and (AAdvInfo = AdvInfo) then
      Exclude(FRefreshNow, rtDetails)
    else
      Include(FRefreshNow, rtDetails);
  finally
    Unlock;
  end;
end;

procedure TRpc.FinishRefresh(ARefresh: TRefreshTypes; AGeneration: cardinal);
begin
  Lock;
  try
    if AGeneration = FRefreshGeneration[ARefresh] then
      Exclude(FRefreshNow, ARefresh)
    else
      Include(FRefreshNow, ARefresh);
  finally
    Unlock;
  end;
end;

procedure TRpc.FileDetailsChanged;
begin
  Lock;
  try
    Inc(FFilePayloadGeneration);
    Inc(FRefreshGeneration[rtDetails]);
    Include(FRefreshNow, rtDetails);
  finally
    Unlock;
  end;
end;

function TRpc.RefreshPending: boolean;
begin
  Lock;
  try
    Result:=FRefreshNow <> [];
  finally
    Unlock;
  end;
end;

function TRpc.RefreshPending(ARefresh: TRefreshTypes): boolean;
begin
  Lock;
  try
    Result:=ARefresh in FRefreshNow;
  finally
    Unlock;
  end;
end;

procedure TRpc.RequestRefresh(const ARefresh: TRefreshType);
var
  RefreshType: TRefreshTypes;
begin
  Lock;
  try
    for RefreshType:=Low(TRefreshTypes) to High(TRefreshTypes) do
      if RefreshType in ARefresh then
        Inc(FRefreshGeneration[RefreshType]);
    FRefreshNow:=FRefreshNow + ARefresh;
  finally
    Unlock;
  end;
end;

procedure TRpc.SetAdvancedInfo(AAdvInfo: TAdvInfoType; ARefresh: boolean);
begin
  Lock;
  try
    AdvInfo:=AAdvInfo;
    if ARefresh then begin
      Inc(FRefreshGeneration[rtDetails]);
      Include(FRefreshNow, rtDetails);
    end;
  finally
    Unlock;
  end;
end;

procedure TRpc.Unlock;
begin
  FLock.Leave;
end;

procedure TRpc.StopRpcThread;
begin
  if Assigned(RpcThread) then begin
    RpcThread.Terminate;
    Http.Abort;
    RpcThread.WaitFor;
    if not (Http.Sock.SSL is TSSLNone) then
      Http.Sock.SSL.Shutdown;
    Http.Sock.AbortSocket;
    Http.Sock.StopFlag:=False;
    FreeAndNil(RpcThread);
  end;
end;

procedure TRpc.Connect;
begin
  StopRpcThread;
  CurTorrentId:=0;
  XTorrentSession:='';
  RequestFullInfo:=True;
  ReconnectAllowed:=False;
  FRefreshNow:=[];
  RpcThread:=TRpcThread.Create;
  with RpcThread do begin
    FreeOnTerminate:=False;
    FRpc:=Self;
    Suspended:=False;
  end;
end;

procedure TRpc.Disconnect;
begin
  StopRpcThread;
  Status:='';
  RequestStartTime:=0;
  FRpcPath:='';
end;

initialization
  // Keep this lock alive for the lifetime of the process.
  OpenSSLInitLock:=TCriticalSection.Create;

end.