{******************************************}
{                                          }
{             FastReport VCL               }
{            HTTP Report Server            }
{                                          }
{         Copyright (c) 1998-2021          }
{            by Fast Reports Inc.          }
{                                          }
{******************************************}

unit frxServer;

{$I frx.inc}

{$IFDEF Delphi12}
{$WARNINGS OFF}
{$ENDIF}

//{$DEFINE DEBUG}
//{$DEFINE CS_ON}

interface

uses
  Forms,
{$IFDEF FPC}
 {$IFDEF Linux}
  BaseUnix, Unix, LCLType, LCLIntf, Types, LResources, LMessages, LazHelperCS,
 {$ELSE}
  Windows, WinSock,
 {$ENDIF}
  LazHelper, LazSocket,
{$ELSE}
  Windows, WinSock, ScktComp, frxThreading,
{$ENDIF}
  Classes, frxClass, Registry, frxVariables, frxGZip, frxServerLog,
  frxServerSessionManager, frxServerStat, frxServerReports,
  frxServerVariables, frxServerSSI, frxServerUtils, frxNetUtils, frxMD5,
  frxServerCache, frxServerReportsList, frxUnicodeUtils, frxUsers, frxHelperCS
// , frxADOComponents, 
//  DB, ADODB
{$IFDEF FR_FIB}
  , frxFIBComponents, FIBDatabase, pFIBDatabase
{$ENDIF}
  , frxServerClient, SysUtils, frxServerConfig, frxServerTemplates, frxServerPrinter;

type
  TfrxHTTPServer = class;
  TfrxServerSession = class;
  TfrxServerData = class;
  TfrxServerGuard = class;
  TfrxServerGetReportEvent = procedure(const ReportName: String;
    Report: TfrxReport; User: String = '') of object;
  TfrxServerGetVariablesEvent = procedure(const ReportName: String;
    Variables: TfrxVariables; User: String = '') of object;
  TfrxServerAfterBuildReport = procedure(const ReportName: String;
    Variables: TfrxVariables; User: String = '') of object;

  PSecHandle = ^TSecHandle;
  TSecHandle = record
    dwLower: Cardinal;
    dwUpper: Cardinal;
  end;
  TCredHandle = TSecHandle;
  PCredHandle = ^TCredHandle;
  PCtxtHandle = ^TCtxtHandle;
  TCtxtHandle = TSecHandle;

  PSecBuffer = ^TSecBuffer;
  TSecBuffer = record
    cbBuffer: Cardinal;
    BufferType: Cardinal;
    pvBuffer: Pointer;
  end;

  PSecBufferDesc = ^TSecBufferDesc;
  TSecBufferDesc = record
    ulVersion: Cardinal;
    cBuffers: Cardinal;
    pBuffers: PSecBuffer;
  end;

  PTimeStamp = ^TTimeStamp;
  TTimeStamp = Currency;

  PSecPkgInfo = ^TSecPkgInfo;
  TSecPkgInfo = record
    fCapabilities: Cardinal;
    wVersion: Word;
    wRPCID: Word;
    cbMaxToken: Cardinal;
    Name: PChar;
    Comment: PChar;
  end;

{$IFDEF DELPHI16}
[ComponentPlatformsAttribute(pidWin32 or pidWin64)]
{$ENDIF}
  TfrxReportServer = class(TComponent)
  private
    FActive: Boolean;
    FAllow: TStrings;
    FDeny: TStrings;
    FGetReport: TfrxServerGetReportEvent;
    FPDFPrint: Boolean;
    FTotals: TStrings;
    FConfigLoaded: Boolean;
    FVariables: TfrxServerVariables;
    FWebServer: TfrxHTTPServer;
    FGetVariables: TfrxServerGetVariablesEvent;
    FBuildReport: TfrxServerAfterBuildReport;
    FBusy: Boolean;
//    FADOComponents: TfrxADOComponents;
//    FADOConnection: TADOConnection;

{$IFDEF FR_FIB}
    FFIBComponents: TfrxFIBComponents;
    FfrxFIBConnection: TfrxFIBDatabase;
{$ENDIF}

    FSocketOpen: Boolean;
    FConfigFileName: String;
    FGuard: TfrxServerGuard;
    FPrint: Boolean;
    function GetTotals: TStrings;
    procedure SetActive(const Value: Boolean);
    procedure StatToVar;
//    procedure IdleEventHandler(Sender: TObject; var Done: Boolean);
    procedure Initialize;
  public
    constructor Create(AOwner: TComponent); override;
    constructor CreateWithRoot(const Folder: String; const Socket: Boolean);
    destructor Destroy; override;
    procedure Open;
    procedure Close;
    procedure Get(Data: TfrxServerData);
    function LoadConfigs: Boolean;
    property Totals: TStrings read GetTotals;
    property Variables: TfrxServerVariables read FVariables;
    property WebServer: TfrxHTTPServer read FWebServer;
  published
    procedure Loaded; override;
    property Active: Boolean read FActive write SetActive;
    property AllowIP: TStrings read FAllow write FAllow;
    property DenyIP: TStrings read FDeny write FDeny;
    property PrintPDF: Boolean read FPDFPrint write FPDFPrint;
    property Print: Boolean read FPrint write FPrint;
    property OnGetReport: TfrxServerGetReportEvent read FGetReport
      write FGetReport;
    property OnGetVariables: TfrxServerGetVariablesEvent read FGetVariables
      write FGetVariables;
    property OnAfterBuildReport: TfrxServerAfterBuildReport read FBuildReport
      write FBuildReport;
    property SocketOpen: Boolean read FSocketOpen write FSocketOpen;
    property ConfigFileName: String read FConfigFileName write FConfigFileName;
  end;

  TfrxHTTPServer = class(TServerSocket)
  private
    FBasePath: String;
    FGzip: Boolean;
    FMainDocument: String;
    FNoCacheHeader: Boolean;
    FParentReportServer: TfrxReportServer;
    FReportPath: String;
    FSocketTimeOut: Integer;
    FMaxHTTPHeaderSize: Integer;
    FMaxContentSize: Int64;
    procedure ClientAccept(Sender: TObject; Socket: TCustomWinSocket);
    procedure ClientDisconnect(Sender: TObject; Socket: TCustomWinSocket);
    procedure ClientError(Sender: TObject; Socket: TCustomWinSocket;
         ErrorEvent: TErrorEvent; var ErrorCode: Integer);
    procedure GetThread(Sender: TObject; ClientSocket: TServerClientWinSocket;
         var SocketThread: TServerClientThread);
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
  published
    property BasePath: String read FBasePath write FBasePath;
    property Gzip: Boolean read FGzip write FGzip;
    property MainDocument: String read FMainDocument write FMainDocument;
    property NoCacheHeader: Boolean read FNoCacheHeader write FNoCacheHeader;
    property ParentReportServer: TfrxReportServer read FParentReportServer
      write FParentReportServer;
    property ReportPath: String read FReportPath write FReportPath;
    property SocketTimeOut: Integer read FSocketTimeOut write FSocketTimeOut;
  end;

  TfrxServerSession = class(TServerClientThread)
  private
    FAuthNeeded: Boolean;
    FDialog: Boolean;
    FDialogSessionId: AnsiString;
    FErrorCode: Integer;
    FErrorText: AnsiString;
    FFormat: TfrxServerFormat;
    FGzip: Boolean;
    FHeader: AnsiString;
    FHost: AnsiString;
    FHTTPVersion: AnsiString;
    FIsReport: Boolean;
    FKeepAlive: boolean;
    FMethod: AnsiString;
    FMIMEType: AnsiString;
    FMultipage: Boolean;
    FName: AnsiString;
    FReportName: AnsiString;
    FGroup: AnsiString;
    FNoCacheHeader: Boolean;
    FPageNavigator: Boolean;
    FPageRange: String;
    FParentHTTPServer: TfrxHTTPServer;
    FParentReportServer: TfrxReportServer;
    FRedirect: Boolean;
    FReferer: AnsiString;
    FRemoteIP: String;
    FReplyBody: TStringList;
    FReplyHeader: TStringList;
    FRepSession: TfrxReportSession;
    FResultPage: String;
    FServerReplyData: TStringList;
    FSessionId: AnsiString;
    FSessionItem: TfrxSessionItem;
    FSize: integer;
    FUserAgent: AnsiString;
    FVariables: TfrxVariables;
    FStream: TMemoryStream;
    FFileDate: TDateTime;
    FCacheId: String;
    FPrn: String;
    FBrowserPrn: Boolean;
    FLogin: String;
    FCookie: AnsiString;
    FPassword: String;
    FReportMessage: String;
    FReturnData: AnsiString;
    FIsExportRedirect: Boolean;
    FInParams: TStringList;
    FOutParams: TStringList;
    FData: TfrxServerData;
    FActive: Boolean;
    FAuthInProgress: Boolean;
    FAuthResponse: AnsiString;
    FAuthFinished: Boolean;
    FAuthNewConv: Boolean;
    FMaxTokenSize: integer;
    FCredHandle: TSecHandle;
    FExpire: TTimeStamp;
    FToken: cardinal;
    FContextHandle: TSecHandle;
    FAuthType: String;
    FLocalVariables: TfrxServerVariables;
    FReportTitle: String;
    FmPage: String;
    FContentMD5: AnsiString;
    FContentLength: Int64;
    FIsFP3: Boolean;
    FBoundary: AnsiString;
    FFormFileName: String;

    function InitAuth(const SecPackageName: String): boolean;
    function ProcessAuthRequest(AuthRequest: AnsiString; NewConversation: boolean; var AuthResponse: AnsiString;
      var ContextHandle: TSecHandle; var AuthFinished: boolean): boolean;
    procedure FinalAuth;
    function GetCurrentUserToken: {$IFDEF DEL16ORFPC} THandle {$ELSE} cardinal {$ENDIF};
    function CheckBadPath: Boolean;
    function CheckDeflate(FileName: String): Boolean;
    function CheckSSI(FileName: String): Boolean;
    function ParseHeaderField(const Field: AnsiString): AnsiString; overload;
    function ParseHeaderField(const Field: AnsiString; Const aHeader: AnsiString): AnsiString; overload;
    function ParseParam(S: String): String;
    function GetMime(s: String): String;
    procedure CheckAuth;
    procedure CloseSession;
    procedure CreateReplyHTTPData;
    procedure ErrorLog;
    procedure MakeServerReply;
    procedure ParseHTTPHeader;
    procedure ParseParameters;
    procedure SelectFormat(FormatName: String);
    procedure IsFP3Content(aContent: AnsiString);
    procedure UpdateLocalVariables;
    procedure UpdateSessionFName;
    procedure WriteLogs;
    procedure DoGetVariables;
    procedure AddOutData(const Name: String; const Value: String);
    procedure WriteHtmlReportIndex(OutStream: TfrxSSIStream);
  public
    constructor Create(CreateSuspended: Boolean;
      ASocket: TServerClientWinSocket);
    destructor Destroy; override;
    procedure ClientExecute; override;
    procedure PrepareReportQuery;

    function GetSessionPath: AnsiString;

    property NoCacheHeader: Boolean read FNoCacheHeader write FNoCacheHeader;
    property ParentHTTPServer: TfrxHTTPServer read FParentHTTPServer
      write FParentHTTPServer;
    property ParentReportServer: TfrxReportServer read FParentReportServer
      write FParentReportServer;
    property SessionId: AnsiString read GetSessionPath write FSessionId;
    property SessionItem: TfrxSessionItem read FSessionItem write FSessionItem;
    property Login: String read FLogin;
    property Password: String read FPassword;
    property Data: TfrxServerData read FData write FData;
    property Active: Boolean read FActive write FActive;
    property LocalVariables: TfrxServerVariables read FLocalVariables;
  end;

  TfrxServerData = class(TObject)
  private
    FErrorCode: Integer;
    FInParams: TStringList;
    FOutParams: TStringList;
    FStream: TMemoryStream;
    FFileName: String;
    FHeader: String;
    FRepHeader: String;
    FHTTPVer: String;
    FLastMod: TDateTime;
    FExpires: TDateTime;
  public
    constructor Create;
    destructor Destroy; override;
    procedure Assign(Source: TfrxServerData);

    property InParams: TStringList read FInParams;
    property OutParams: TStringList read FOutParams;
    property ErrorCode: Integer read FErrorCode write FErrorCode;
    property Stream: TMemoryStream read FStream;
    property FileName: String read FFileName write FFileName;
    property Header: String read FHeader write FHeader;
    property RepHeader: String read FRepHeader write FRepHeader;
    property HTTPVer: String read FHTTPVer write FHTTPVer;
    property Expires: TDateTime read FExpires write FExpires;
    property LastMod: TDateTime read FLastMod write FLastMod;
  end;

  TfrxServerGuard = class(TThread)
  private
    FTimeOut: Integer;
    FServer: TfrxReportServer;
    FListTimeOut: Integer;
    procedure DoLoadConf;
  protected
    procedure Execute; override;
  public
    constructor Create(Server: TfrxReportServer);
    destructor Destroy; override;
    property TimeOut: Integer read FTimeOut write FTimeOut;
    property ListTimeOut: Integer read FListTimeOut write FListTimeOut;
  end;

const
  MAX_IE_GZIP = 4096;
  SERVER_NAME = 'FastReport VCL Enterprise'{$IFDEF FR_FIB} + ' Firebird edition'{$ENDIF};
  SERVER_VERSION = {$I frxVersion.inc};
  SERVER_DATA = '';
  SID_SIGN = 'sid_f';
  SID_STORE = 'store_';

implementation

uses frxUtils, frxFileUtils, SyncObjs, StrUtils, frxMutex{$IFNDEF Linux}, ComObj{$ENDIF};

const
  SERVER_COPY = '© Copyright 1998-2020 by Fast Reports Inc.';
  METHOD_GET = 'GET';
  METHOD_POST = 'POST';
  HTML = 'text/html';
  ERR_UNKNOWN_METHOD = '1';
  ERR_OK = '0';
  SECPKG_CRED_INBOUND  = $00000001;
  SECBUFFER_VERSION = 0;
  SECBUFFER_TOKEN = 2;
  SECURITY_NATIVE_DREP = $00000010;
  SEC_I_COMPLETE_NEEDED = HRESULT($00090313);
  SEC_I_COMPLETE_AND_CONTINUE = HRESULT($00090314);
  SEC_I_CONTINUE_NEEDED = HRESULT($00090312);
  NameSamCompatible = 2;
  secur32 = 'secur32.dll';
  MAX_HTTP_HEADER_SIZE = 16384;

type
  TSecGetKeyFn = procedure (
    Arg: Pointer;
    Principal: Pointer;
    KeyVer: Cardinal;
    var Key: Pointer;
    var Status: Cardinal); stdcall;
{$IFNDEF Linux}
{$IFDEF WIN64}
  TfrxAcceptSecurityContext = function (phCredential: PCredHandle; phContext: PCtxtHandle;
    pInput: PSecBufferDesc; fContextReq, TargetDataRep: Cardinal;
    phNewContext: PCtxtHandle; pOutput: PSecBufferDesc; var pfContextAttr: Cardinal;
    ptsExpiry: PTimeStamp): Cardinal; stdcall;
  TfrxCompleteAuthToken = function (phContext: PCtxtHandle; pToken: PSecBufferDesc): Cardinal; stdcall;
  TfrxImpersonateSecurityContext = function(phContext: PCtxtHandle): Cardinal; stdcall;
  TfrxRevertSecurityContext = function (phContext: PCtxtHandle): Cardinal; stdcall;
  TfrxQuerySecurityPackageInfo = function (pszPackageName: PChar;
    var ppPackageInfo: PSecPkgInfo): Cardinal; stdcall;
  TfrxAcquireCredentialsHandle = function (pszPrincipal, pszPackage: PChar;
    fCredentialUse: Cardinal; pvLogonId, pAuthData: Pointer;
    pGetKeyFn: TSecGetKeyFn; pvGetKeyArgument: Pointer; phCredential: PCredHandle;
    var ptsExpiry: TTimeStamp): Cardinal; stdcall;
  TfrxFreeCredentialsHandle = function (phCredential: PCredHandle): Cardinal; stdcall;
  TfrxFreeContextBuffer = function (pvContextBuffer: Pointer): Cardinal; stdcall;
  TfrxGetUserNameEx = function (NameFormat: cardinal; lpNameBuffer: PChar;
    var nSize: cardinal): ByteBool; stdcall;
{$ENDIF}

function AcceptSecurityContext(phCredential: PCredHandle; phContext: PCtxtHandle;
  pInput: PSecBufferDesc; fContextReq, TargetDataRep: Cardinal;
  phNewContext: PCtxtHandle; pOutput: PSecBufferDesc; var pfContextAttr: Cardinal;
  ptsExpiry: PTimeStamp): Cardinal; stdcall; forward;

function CompleteAuthToken(phContext: PCtxtHandle; pToken: PSecBufferDesc): Cardinal; stdcall; forward;

function ImpersonateSecurityContext(phContext: PCtxtHandle): Cardinal; stdcall; forward;

function RevertSecurityContext(phContext: PCtxtHandle): Cardinal; stdcall; forward;

function QuerySecurityPackageInfo(pszPackageName: PChar;
  var ppPackageInfo: PSecPkgInfo): Cardinal; stdcall; forward;

function AcquireCredentialsHandle(pszPrincipal, pszPackage: PChar;
  fCredentialUse: Cardinal; pvLogonId, pAuthData: Pointer;
  pGetKeyFn: TSecGetKeyFn; pvGetKeyArgument: Pointer; phCredential: PCredHandle;
  var ptsExpiry: TTimeStamp): Cardinal; stdcall; forward;

function FreeCredentialsHandle(phCredential: PCredHandle): Cardinal; stdcall; forward;

function FreeContextBuffer(pvContextBuffer: Pointer): Cardinal; stdcall; forward;

function GetUserNameEx(NameFormat: cardinal; lpNameBuffer: PChar;
  var nSize: cardinal): ByteBool; stdcall; forward;
{$ENDIF}


var
  ServCS: TCriticalSection;
{$IFNDEF Linux}
{$IFDEF WIN64}
  _AcceptSecurityContext: TfrxAcceptSecurityContext;
  _CompleteAuthToken: TfrxCompleteAuthToken;
  _ImpersonateSecurityContext: TfrxImpersonateSecurityContext;
  _RevertSecurityContext: TfrxRevertSecurityContext;
  _QuerySecurityPackageInfo: TfrxQuerySecurityPackageInfo;
  _AcquireCredentialsHandle: TfrxAcquireCredentialsHandle;
  _FreeCredentialsHandle: TfrxFreeCredentialsHandle;
  _FreeContextBuffer: TfrxFreeContextBuffer;
  _GetUserNameEx: TfrxGetUserNameEx;
{$ELSE}
  _AcceptSecurityContext: Pointer;
  _CompleteAuthToken: Pointer;
  _ImpersonateSecurityContext: Pointer;
  _RevertSecurityContext: Pointer;
  _QuerySecurityPackageInfo: Pointer;
  _AcquireCredentialsHandle: Pointer;
  _FreeCredentialsHandle: Pointer;
  _FreeContextBuffer: Pointer;
  _GetUserNameEx: Pointer;
{$ENDIF}

procedure GetProcedureAddress(var P: Pointer; const ModuleName, ProcName: string);
var ModuleHandle: HMODULE;
begin
  if not Assigned(P) then
  begin
    ModuleHandle := GetModuleHandle(PChar(ModuleName));
    if ModuleHandle = 0 then
    begin
      ModuleHandle := LoadLibrary(PChar(ModuleName));
      if ModuleHandle = 0 then
        raise Exception.Create('Library not found: ' + ModuleName);
    end;
    P := GetProcAddress(ModuleHandle, PChar(ProcName));
    if not Assigned(P) then
      raise Exception.Create('Function not found: ' + ModuleName + '.' + ProcName);
  end;
end;

{$IFNDEF Delphi12}
{$WARNINGS OFF}
{$ENDIF}

{$IFDEF WIN64}

function AcceptSecurityContext(phCredential: PCredHandle; phContext: PCtxtHandle;
  pInput: PSecBufferDesc; fContextReq, TargetDataRep: Cardinal;
  phNewContext: PCtxtHandle; pOutput: PSecBufferDesc; var pfContextAttr: Cardinal;
  ptsExpiry: PTimeStamp): Cardinal; stdcall;
begin
  GetProcedureAddress(@_AcceptSecurityContext, secur32, 'AcceptSecurityContext');
  if @_AcceptSecurityContext <> nil then
    Result := _AcceptSecurityContext(phCredential, phContext,
       pInput, fContextReq, TargetDataRep,
       phNewContext, pOutput, pfContextAttr, ptsExpiry);
end;

function CompleteAuthToken(phContext: PCtxtHandle; pToken: PSecBufferDesc): Cardinal; stdcall;
begin
  GetProcedureAddress(@_CompleteAuthToken, secur32, 'CompleteAuthToken');
  if @_CompleteAuthToken <> nil then
    Result := _CompleteAuthToken(phContext, pToken);
end;

function ImpersonateSecurityContext(phContext: PCtxtHandle): Cardinal; stdcall;
begin
  GetProcedureAddress(@_ImpersonateSecurityContext, secur32, 'ImpersonateSecurityContext');
  if @_ImpersonateSecurityContext <> nil then
    Result := _ImpersonateSecurityContext(phContext);
end;

function RevertSecurityContext(phContext: PCtxtHandle): Cardinal; stdcall;
begin
  GetProcedureAddress(@_RevertSecurityContext, secur32, 'RevertSecurityContext');
  if @_RevertSecurityContext <> nil then
    Result := _RevertSecurityContext(phContext);
end;

function QuerySecurityPackageInfo(pszPackageName: PChar;
  var ppPackageInfo: PSecPkgInfo): Cardinal; stdcall;
begin
  GetProcedureAddress(@_QuerySecurityPackageInfo, secur32, 'QuerySecurityPackageInfoA');
  if @_QuerySecurityPackageInfo <> nil then
    Result := _QuerySecurityPackageInfo(pszPackageName, ppPackageInfo);
end;

function AcquireCredentialsHandle(pszPrincipal, pszPackage: PChar;
  fCredentialUse: Cardinal; pvLogonId, pAuthData: Pointer;
  pGetKeyFn: TSecGetKeyFn; pvGetKeyArgument: Pointer; phCredential: PCredHandle;
  var ptsExpiry: TTimeStamp): Cardinal; stdcall;
begin
  GetProcedureAddress(@_AcquireCredentialsHandle, secur32, 'AcquireCredentialsHandleA');
  if  @_AcquireCredentialsHandle <> nil then
    Result := _AcquireCredentialsHandle(pszPrincipal, pszPackage,
      fCredentialUse, pvLogonId, pAuthData,
      pGetKeyFn, pvGetKeyArgument, phCredential, ptsExpiry);
end;

function FreeCredentialsHandle(phCredential: PCredHandle): Cardinal; stdcall;
begin
  GetProcedureAddress(@_FreeCredentialsHandle, secur32, 'FreeCredentialsHandle');
  if @_FreeCredentialsHandle <> nil then
    Result := _FreeCredentialsHandle(phCredential);
end;

function FreeContextBuffer(pvContextBuffer: Pointer): Cardinal; stdcall;
begin
  GetProcedureAddress(@_FreeContextBuffer, secur32, 'FreeContextBuffer');
  if @_FreeContextBuffer <> nil then
    Result := _FreeContextBuffer(pvContextBuffer);
end;

function GetUserNameEx(NameFormat: cardinal; lpNameBuffer: PChar;
  var nSize: cardinal): ByteBool; stdcall;
begin
  GetProcedureAddress(@_GetUserNameEx, secur32, 'GetUserNameExA');
  if @_GetUserNameEx <> nil then
    Result := _GetUserNameEx(NameFormat, lpNameBuffer, nSize);
end;

{$ELSE}

function FreeContextBuffer;
begin
  GetProcedureAddress(_FreeContextBuffer, secur32, 'FreeContextBuffer');
  asm
    mov esp, ebp
    pop ebp
    jmp [_FreeContextBuffer]
  end;
end;

function FreeCredentialsHandle;
begin
  GetProcedureAddress(_FreeCredentialsHandle, secur32, 'FreeCredentialsHandle');
  asm
    mov esp, ebp
    pop ebp
    jmp [_FreeCredentialsHandle]
  end;
end;

function AcquireCredentialsHandle;
begin
  GetProcedureAddress(_AcquireCredentialsHandle, secur32, 'AcquireCredentialsHandleA');
  asm
    mov esp, ebp
    pop ebp
    jmp [_AcquireCredentialsHandle]
  end;
end;

function AcceptSecurityContext;
begin
  GetProcedureAddress(_AcceptSecurityContext, secur32, 'AcceptSecurityContext');
  asm
    mov esp, ebp
    pop ebp
    jmp [_AcceptSecurityContext]
  end;
end;

function CompleteAuthToken;
begin
  GetProcedureAddress(_CompleteAuthToken, secur32, 'CompleteAuthToken');
  asm
    mov esp, ebp
    pop ebp
    jmp [_CompleteAuthToken]
  end;
end;

function ImpersonateSecurityContext;
begin
  GetProcedureAddress(_ImpersonateSecurityContext, secur32, 'ImpersonateSecurityContext');
  asm
    mov esp, ebp
    pop ebp
    jmp [_ImpersonateSecurityContext]
  end;
end;

function RevertSecurityContext;
begin
  GetProcedureAddress(_RevertSecurityContext, secur32, 'RevertSecurityContext');
  asm
    mov esp, ebp
    pop ebp
    jmp [_RevertSecurityContext]
  end;
end;

function QuerySecurityPackageInfo;
begin
  GetProcedureAddress(_QuerySecurityPackageInfo, secur32, 'QuerySecurityPackageInfoA');
  asm
    mov esp, ebp
    pop ebp
    jmp [_QuerySecurityPackageInfo]
  end;
end;

function GetUserNameEx;
begin
  GetProcedureAddress(_GetUserNameEx, secur32, 'GetUserNameExA');
  asm
    mov esp, ebp
    pop ebp
    jmp [_GetUserNameEx]
  end;
end;
{$ENDIF}
{$ENDIF}
{$IFNDEF Delphi12}
{$WARNINGS ON}
{$ENDIF}

{ TfrxReportServer }

function TfrxReportServer.LoadConfigs: Boolean;
begin
  result := ServerConfig.LoadFromFile(frxGetAbsPathDir(FConfigFileName, ServerConfig.ConfigFolder)) <> E_FAIL;
  if result then
    ServerUsers.LoadFromFile(frxGetAbsPathDir(ServerConfig.GetValue('server.security.usersfile'), ServerConfig.ConfigFolder));
end;

procedure TfrxReportServer.Loaded;
begin
  if csLoading in ComponentState then
    Initialize;
  inherited;
end;

procedure TfrxReportServer.Initialize;
var
  s: String;
  templates_path, root_path, config_path: String;
begin

  if FConfigFileName = '' then
    FConfigFileName := 'config.xml';
  FConfigLoaded := LoadConfigs;

  if FConfigLoaded then
  begin
    LogWriter := TfrxServerLog.Create;
    templates_path := frxGetAbsPathDir(ServerConfig.GetValue('server.http.templatespath'), ServerConfig.ConfigFolder);
    root_path := frxGetAbsPathDir(ServerConfig.GetValue('server.http.rootpath'), ServerConfig.ConfigFolder);

    CopyFiles(templates_path, root_path, '*.js *.css', '', false);
    s := 'FrImages';
    if not DirectoryExists(root_path + s) then
      CreateDir(root_path + s);
    CopyFiles(templates_path + s, root_path + s, '*.*', '', true);

    LogWriter.MaxLogSize := StrToInt(ServerConfig.GetValue('server.logs.rotatesize'));
    LogWriter.MaxLogFiles := StrToInt(ServerConfig.GetValue('server.logs.rotatefiles'));
    LogWriter.LogDir := frxGetAbsPathDir(ServerConfig.GetValue('server.logs.path'), ServerConfig.ConfigFolder);
    LogWriter.AddLevel(ServerConfig.GetValue('server.logs.errorlog'));
    LogWriter.AddLevel(ServerConfig.GetValue('server.logs.accesslog'));
    LogWriter.AddLevel(ServerConfig.GetValue('server.logs.refererlog'));
    LogWriter.AddLevel(ServerConfig.GetValue('server.logs.agentlog'));
    LogWriter.AddLevel(ServerConfig.GetValue('server.logs.serverlog'));
    LogWriter.AddLevel(ServerConfig.GetValue('server.logs.schedulerlog'));

    FBusy := False;
{
    FADOConnection := TADOConnection.Create(nil);
    FADOConnection.LoginPrompt := False;
    FADOConnection.ConnectionString := ServerConfig.GetValue('server.database.connectionstring');
    FADOConnection.Name := 'ADOConnection';
    FADOComponents := TfrxADOComponents.Create(nil);
    FADOComponents.DefaultDatabase := FADOConnection;
}
  {$IFDEF FR_FIB}
    FfrxFIBConnection := TfrxFIBDatabase.Create(nil);
    FfrxFIBConnection.FromString(ServerDB.GetFIBConnectionString(ServerConfig.GetValue('server.database.connection')));
    FFIBComponents := TfrxFIBComponents.Create(nil);
    FFIBComponents.DefaultDatabase := FfrxFIBConnection.Database;
    try
      FfrxFIBConnection.Database.SQLDialect := 3;
      FfrxFIBConnection.Database.Open;
    except
      on E:Exception do
      begin
        LogWriter.Write(SERVER_LEVEL, 'DATABASE ERROR! ' + E.Message + #13#10);
      end;
    end;
  {$ENDIF}

    FAllow := TfrxStringListMask.Create;
    FDeny := TfrxStringListMask.Create;

    s := frxGetAbsPathDir(ServerConfig.GetValue('server.security.allowfile'), ServerConfig.ConfigFolder);
    if FileExists(s) then
      FAllow.LoadFromFile(s{$IFDEF Delphi12},TEncoding.UTF8{$ENDIF});
    s := frxGetAbsPathDir(ServerConfig.GetValue('server.security.denyfile'), ServerConfig.ConfigFolder);
    if FileExists(s) then
      FDeny.LoadFromFile(s{$IFDEF Delphi12},TEncoding.UTF8{$ENDIF});

    FTotals := TStringList.Create;
    LogWriter.Write(SERVER_LEVEL, DateTimeToStr(Now) + #9'Started');
    LogWriter.Write(SERVER_LEVEL, 'Logs path:' + #9 + frxGetAbsPathDir(ServerConfig.GetValue('server.logs.path'), ServerConfig.ConfigFolder));
    LogWriter.Write(SERVER_LEVEL, 'Reports path:' + #9 + frxGetAbsPathDir(ServerConfig.GetValue('server.reports.path'), ServerConfig.ConfigFolder));
    LogWriter.Write(SERVER_LEVEL, 'Reports cache path:' + #9 + frxGetAbsPathDir(ServerConfig.GetValue('server.cache.path'), ServerConfig.ConfigFolder));
    LogWriter.Write(SERVER_LEVEL, 'Root path:' + #9 + root_path);
    config_path := '';
    if ExtractFileName(FConfigFileName) = FConfigFileName then
      config_path := GetAppPath;
    if FileExists(config_path + FConfigFileName) then
      LogWriter.Write(SERVER_LEVEL, 'Config file:' + #9 + FConfigFileName)
    else
      LogWriter.Write(SERVER_LEVEL, 'ERROR! Config file ' + FConfigFileName + ' not found!');

    SessionManager := TfrxSessionManager.Create;
    FWebServer := TfrxHTTPServer.Create(nil);
    FWebServer.ParentReportServer := Self;
    ReportCache := TfrxServerCache.Create;
    ResultCache := TfrxResultCache.Create(root_path, SID_STORE);
    ServerStatistic := TfrxServerStatistic.Create;
    FVariables := TfrxServerVariables.Create;
    ServerPrinter := TfrxServerPrinter.Create;
  
    ServerUsers.LoadFromFile(ServerConfig.GetValue('server.security.usersfile'));

  
    FVariables.AddVariable('SERVER_NAME', ServerConfig.GetValue('server.name'));
  

    FVariables.AddVariable('SERVER_COPYRIGHT', SERVER_COPY);
    FVariables.AddVariable('SERVER_SOFTWARE', SERVER_VERSION);
    FVariables.AddVariable('SERVER_LAST_UPDATE', SERVER_DATA);

    FPDFPrint := False;
    FPrint := True;
    Active := False;

    ReportCache.Clear;
    ResultCache.Clear;
    ReportsList := TfrxServerReportsList.Create;

    LogWriter.Active := ServerConfig.GetBool('server.logs.active');

    FGuard := TfrxServerGuard.Create(Self);
  end;

end;

constructor TfrxReportServer.CreateWithRoot(const Folder: String; const Socket: Boolean);
begin
  inherited Create(nil);
  FSocketOpen := Socket;
  FConfigLoaded := false;
  ServerConfig.ConfigFolder := Folder;
  if not(csLoading in ComponentState) then
    Initialize;
end;

constructor TfrxReportServer.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  FConfigLoaded := false;
  ServerConfig.ConfigFolder := GetAppPath;
  FSocketOpen := True;
  if not((AOwner <> nil) and (csLoading in AOwner.ComponentState)) then
    Initialize;
end;

destructor TfrxReportServer.Destroy;
begin
  if FConfigLoaded then
  begin
//    FADOConnection.Free;
//    FADOComponents.Free;

  
    FWebServer.Free;
    ReportCache.Terminate;
    ResultCache.Terminate;
    PMessages;
    ReportCache.Free;
    ResultCache.Free;
    ServerPrinter.Terminate;
    PMessages;
    ServerPrinter.Free;
    FGuard.Terminate;
    PMessages;
    FGuard.Free;
    FAllow.Free;
    FDeny.Free;
    LogWriter.Write(SERVER_LEVEL, DateTimeToStr(Now) + #9'Stopped'#9 + #13#10 + Totals.Text);
    LogWriter.Flush;
    if Active then
      Active := False;
    ServerStatistic.Free;
    SessionManager.Free;
    FTotals.Free;
    FVariables.Free;
    LogWriter.Free;
    ReportsList.Free;
  end;
  inherited;
end;

procedure TfrxReportServer.SetActive(const Value: Boolean);
begin
  if FConfigLoaded and SocketOpen then
  begin
    try
      FWebServer.Active := Value;
    except
      on E:Exception do
      begin
        if Value then
          LogWriter.Write(SERVER_LEVEL, DateTimeToStr(Now) + #9'Port open failed. ' + E.Message + #13#10)
        else
          LogWriter.Write(SERVER_LEVEL, DateTimeToStr(Now) + #9'Port close failed. ' + E.Message + #13#10)
      end;
    end;
  end;
  if FConfigLoaded and (FWebServer.Active = Value) then
    FActive := Value;
end;

procedure TfrxReportServer.Open;
begin
  if FConfigLoaded and ServerConfig.GetBool('server.security.reportslist') then
  begin
    ReportsList.ReportsPath := frxGetAbsPathDir(ServerConfig.GetValue('server.reports.path'), ServerConfig.ConfigFolder);
    ReportsList.BuildListOfReports;
    Active := True;
  end;
end;

procedure TfrxReportServer.Close;
begin
  if FConfigLoaded  then
  begin
    Active := False;
    ReportCache.Clear;
    ResultCache.Clear;
  end;
end;

function TfrxReportServer.GetTotals: TStrings;
begin
  FTotals.Clear;
  FTotals.Add('Uptime: ' + ServerStatistic.FormatUpTime);
  FTotals.Add('Total sessions: ' + IntToStr(ServerStatistic.TotalSessionsCount));
  FTotals.Add('Total reports: ' + IntToStr(ServerStatistic.TotalReportsCount));
  FTotals.Add('Total cache hits: ' + IntToStr(ServerStatistic.TotalCacheHits));
  FTotals.Add('Total errors: ' + IntToStr(ServerStatistic.TotalErrors));
  FTotals.Add('Max sessions: ' + IntToStr(ServerStatistic.MaxSessionsCount));
  FTotals.Add('Max reports: ' + IntToStr(ServerStatistic.MaxReportsCount));
  Result := FTotals;
end;

procedure TfrxReportServer.StatToVar;
begin
  FVariables.AddVariable('SERVER_UPTIME', ServerStatistic.FormatUpTime);
  FVariables.AddVariable('SERVER_TOTAL_SESSIONS', IntToStr(ServerStatistic.TotalSessionsCount));
  FVariables.AddVariable('SERVER_TOTAL_REPORTS', IntToStr(ServerStatistic.TotalReportsCount));
  FVariables.AddVariable('SERVER_TOTAL_ERRORS', IntToStr(ServerStatistic.TotalErrors));
  FVariables.AddVariable('SERVER_TOTAL_CACHE', IntToStr(ServerStatistic.TotalCacheHits));
  FVariables.AddVariable('SERVER_MAX_SESSIONS', IntToStr(ServerStatistic.MaxSessionsCount));
  FVariables.AddVariable('SERVER_MAX_REPORTS', IntToStr(ServerStatistic.MaxReportsCount));
  FVariables.AddVariable('SERVER_CURRENT_SESSIONS', IntToStr(ServerStatistic.CurrentSessionsCount));
  FVariables.AddVariable('SERVER_CURRENT_REPORTS', IntToStr(ServerStatistic.CurrentReportsCount));
end;

procedure TfrxReportServer.Get(Data: TfrxServerData);
var
  Session: TfrxServerSession;
  Socket: TServerClientWinSocket;
begin
  Socket := TServerClientWinSocket.Create(-1, FWebServer.Socket);
  FWebServer.GetThread(nil, Socket, TServerClientThread(Session));
  Session.Data := Data;
  Session.Active := True;
  Session.Resume;
  while Session.Active do
    Sleep(10);
  SessionManager.CompleteSessionId(String(TCustomWinSocket(Socket).Data));
end;

{ TfrxHTTPServer }

constructor TfrxHTTPServer.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  Active := False;
  ServerType := stThreadBlocking;
  Port := StrToInt(ServerConfig.GetValue('server.http.port'));
  FGzip := ServerConfig.GetBool('server.http.compression');
  FMainDocument := ServerConfig.GetValue('server.http.indexfile');
  FBasePath := frxGetAbsPathDir(ServerConfig.GetValue('server.http.rootpath'), ServerConfig.ConfigFolder);
  FSocketTimeOut := StrToInt(ServerConfig.GetValue('server.http.sockettimeout'));
  FNoCacheHeader := ServerConfig.GetBool('server.http.nocacheheader');
  FMaxHTTPHeaderSize := ServerConfig.GetNumber('server.http.headermaxsize');
  if (FMaxHTTPHeaderSize > MAX_HTTP_HEADER_SIZE) or (FMaxHTTPHeaderSize <= 0) then
    FMaxHTTPHeaderSize := MAX_HTTP_HEADER_SIZE;
  FMaxContentSize := ServerConfig.GetNumber('server.http.contentmaxsize') * 1024 * 1024; // MB
  OnClientError := ClientError;
  OnClientDisconnect := ClientDisconnect;
  OnAccept := ClientAccept;
  OnGetThread := GetThread;
  LogWriter.Write(SERVER_LEVEL, DateTimeToStr(Now) + #9'HTTP server created');
end;

destructor TfrxHTTPServer.Destroy;
begin
  LogWriter.Write(SERVER_LEVEL, DateTimeToStr(Now) + #9'HTTP server closed');
  inherited;
end;

procedure TfrxHTTPServer.ClientError(Sender: TObject;
  Socket: TCustomWinSocket; ErrorEvent: TErrorEvent;
  var ErrorCode: Integer);
begin
  if (ErrorCode <> 10053) and (ErrorCode <> 10054) then
  begin
    LogWriter.Write(ERROR_LEVEL, DateTimeToStr(Now) + #9 + Socket.RemoteAddress + #9 + GetSocketErrorText(ErrorCode));
    LogWriter.ErrorReached;
  end;
  ErrorCode := 0;
  SessionManager.CompleteSessionId(String(TCustomWinSocket(Socket).Data));
  Socket.Close;
end;

procedure TfrxHTTPServer.ClientDisconnect(Sender: TObject; Socket: TCustomWinSocket);
begin
  SessionManager.CompleteSessionId(String(TCustomWinSocket(Socket).Data));
end;

procedure TfrxHTTPServer.GetThread(Sender: TObject;
  ClientSocket: TServerClientWinSocket;  var SocketThread: TServerClientThread);
var
  MaxSessions: Integer;
  SessionTimeout: Integer;
begin
  try

    MaxSessions := ServerConfig.GetNumber('server.http.maxsessions');
    SessionTimeout := ServerConfig.GetNumber('server.http.sessiontimeout') * 1000;

    if MaxSessions > 0 then
    begin
      while LogWriter.CurrentSessions > MaxSessions do
      begin
        if SessionTimeout = 0 then
        begin
          LogWriter.Write(ERROR_LEVEL, DateTimeToStr(Now) + #9 + ClientSocket.RemoteAddress + ' Maximum count of sessions has been reached.. ');
          exit;
        end
        else
          Dec(SessionTimeout);
        PMessages;
      end;
    end;

    SocketThread := TfrxServerSession.Create(True, ClientSocket);
    SocketThread.FreeOnTerminate := True;
    SocketThread.KeepInCache := False;
    TfrxServerSession(SocketThread).ParentReportServer := ParentReportServer;
    TfrxServerSession(SocketThread).ParentHTTPServer := Self;
    if ClientSocket <> nil then
      ClientSocket.Data := PChar(TfrxServerSession(SocketThread).SessionId);
    TfrxServerSession(SocketThread).SessionItem := SessionManager.AddSession(TfrxServerSession(SocketThread).SessionId, TCustomWinSocket(ClientSocket));
    if ParentReportServer.SocketOpen then
      SocketThread.Resume;
    FParentReportServer.StatToVar;
  except
    on E:Exception do
      LogWriter.Write(ERROR_LEVEL, DateTimeToStr(Now) + #9 + ClientSocket.RemoteAddress + ' client session creation error. ' + E.Message);
  end;
end;

procedure TfrxHTTPServer.ClientAccept(Sender: TObject;
  Socket: TCustomWinSocket);
begin
  if ParentReportServer.DenyIP.IndexOf(Socket.RemoteAddress) <> -1 then
  begin
    LogWriter.Write(ERROR_LEVEL, DateTimeToStr(Now) + #9 + Socket.RemoteAddress + ' denial of client connection');
    Socket.Close;
  end
  else if (ParentReportServer.AllowIP.Count > 0) and
     (ParentReportServer.AllowIP.IndexOf(Socket.RemoteAddress) = -1) then
  begin
    LogWriter.Write(ERROR_LEVEL, DateTimeToStr(Now) + #9 + Socket.RemoteAddress + ' client connection not allowed');
    Socket.Close;
  end;
end;

{ TfrxServerSession }

constructor TfrxServerSession.Create(CreateSuspended: Boolean; ASocket: TServerClientWinSocket);
begin
  inherited Create(CreateSuspended, ASocket);
  FSessionId := SID_SIGN + MakeSessionId;
  FIsReport := False;
  FSize := 0;
  FKeepAlive := False;
  FRemoteIP := ClientSocket.RemoteAddress;
  FServerReplyData := TStringList.Create;
  FReplyHeader := TStringList.Create;
  FReplyBody := TStringList.Create;
  FFormat := sfHTM;
  FPageRange := '';
  FGzip := False;
  FResultPage := '';
  FRedirect := False;
  FStream := TMemoryStream.Create;
  FInParams := TStringList.Create;
  FOutParams := TStringList.Create;
  {$IFDEF FPC}
  FServerReplyData.LineBreak := #13#10;
  FReplyHeader.LineBreak := #13#10;
  FReplyBody.LineBreak := #13#10;
  FOutParams.LineBreak := #13#10;
  FInParams.LineBreak := #13#10;
  {$ENDIF}
  FData := nil;
  FAuthInProgress := False;
  FAuthFinished := False;
  FAuthNewConv := True;
  FToken := 0;
  FLocalVariables := TfrxServerVariables.Create;
end;

destructor TfrxServerSession.Destroy;
begin
  FLocalVariables.Free;
  FInParams.Free;
  FOutParams.Free;
  FStream.Free;
  FServerReplyData.Free;
  FReplyHeader.Free;
  FReplyBody.Free;
  inherited;
end;

function TfrxServerSession.ParseHeaderField(const Field: AnsiString): AnsiString;
begin
  Result := ParseHeaderField(Field, FHeader);
end;

function TfrxServerSession.ParseHeaderField(const Field: AnsiString; Const aHeader: AnsiString): AnsiString;
var
  i: integer;
  s: Ansistring;
begin
  i := Pos(Field, aHeader);
  Result := '';
  if i > 0 then
  begin
    s := Copy(aHeader, i + Length(Field), Length(aHeader) - i + Length(Field));
    i := Pos(AnsiString(#13#10), s);
    if i > 0 then
      Result := Copy(s, 1, i - 1);
  end;
end;

procedure TfrxServerSession.ParseHTTPHeader;
var
  i, j: Integer;
  ContentType, s: AnsiString;

  function GetBoundary(aValue: AnsiString): AnsiString;
  var
    sPos, Cnt: Integer;
  begin
    Result := '';
    sPos := Pos('boundary=', aValue);
    if (i > 0) and (sPos > 0) then
    begin
      Cnt := PosEx(';', aValue, sPos);
      Inc(sPos, 9);
      if Cnt <= 0 then
        Cnt := Length(aValue) - sPos;
      Result := Copy(aValue, sPos, Cnt);
    end;
  end;

begin

  FMethod := ERR_UNKNOWN_METHOD;
  FErrorCode := 0;
  FReturnData := '';
  i := Pos(AnsiString(' '), FHeader);
  FMethod := Copy(FHeader, 1, i - 1);
  if (FMethod = METHOD_GET) or (FMethod = METHOD_POST) then
  begin
    i := Pos(AnsiString('/'), FHeader);
    if i > 0 then
    begin
      FName := Trim(String(Copy(FHeader, i + 1, Pos(AnsiString('HTTP'), FHeader) - i - 2)));
      FName := HTML2Str(FName);
      FHTTPVersion := Copy(FHeader, Pos(AnsiString('HTTP/'), FHeader), 8);
      FHost := ParseHeaderField('Host: ');
      //FKeepAlive := ParseHeaderField('Connection: ') = 'keep-alive';
      FKeepAlive := False;
      FReferer := ParseHeaderField('Referer: ');
      FUserAgent := ParseHeaderField('User-Agent: ');
      FContentMD5 := ParseHeaderField('Content-MD5: ');
      TryStrToInt64(ParseHeaderField('Content-Length: '), FContentLength);
      if ServerConfig.GetBool('server.security.cgiauth') then
        FLogin := ParseHeaderField('UserName: ')
      else if ServerConfig.GetBool('server.security.remoteauth') then
        FLogin := ParseHeaderField('RemoteUserName: ')
      else if ServerConfig.GetBool('server.security.cookieauth') then
      begin
        FCookie := ParseHeaderField('Cookie: ');
        s := 'LI_USR';
        i := Pos(AnsiString(s), FCookie);
        j := i + Length(s) + 1;
        if (i > 0) then
        begin
          FLogin := '';
          while((FCookie[j] <> ';') and (j <= Length(FCookie))) do
          begin
            FLogin := FLogin + FCookie[j];
            Inc(j);
          end;
        end;
      end;
      ContentType := ParseHeaderField('Content-Type: ');
      { looking for better detection solution }
      IsFP3Content(ContentType);
      FBoundary := GetBoundary(ContentType);
      s := ParseHeaderField('Accept-Encoding: ');
      if Length(s) > 0 then
        if (Pos('gzip', LowerCase(s)) > 0) and (FParentHTTPServer.Gzip) then
          FGzip := True;
      CheckAuth;
      WriteLogs;
    end;
  end;
end;

procedure TfrxServerSession.ParseParameters;
var
  i, j: Integer;
  s, TempName: Ansistring;
  P, V: AnsiString;
  RepName, Redir: AnsiString;
begin
  i := -1;
      if not FAuthNeeded then
      begin
        FKeepAlive := False;
        if (FMethod = METHOD_GET) or ((FMethod = METHOD_POST) and FIsFP3) then
        begin
          i := Pos('?', FName);
          if i > 0 then
          begin
            TempName := Copy(FName, 1, i - 1);
            FName := Copy(FName, i + 1, Length(FName) - i);
          end;
        end else
        { remark : have no idia what this legacy code used for , remove it after testing }
        if (FMethod = METHOD_POST) and (FStream.Size > 0) then
        begin
          SetLength(FName, FStream.Size);
          FStream.Position := 0;
          FStream.ReadBuffer(FName[1], FStream.Size);  // check
        end;
        s := ParseParam('getvariable');
        if Length(s) = 0 then
        begin
          RepName := ParseParam('report');
          {$IFDEF FPC}
          {$IFDEF Linux}
          RepName := StringReplace(RepName, '\', '/', [rfReplaceAll]);
          {$ELSE}
          RepName := StringReplace(RepName, '/', '\', [rfReplaceAll]);
          {$ENDIF}
          {$ENDIF}
          Redir := ParseParam('dialog_redirect');
          if Redir = '' then
          begin
            Redir := ParseParam('export_redirect');
            if Redir <> '' then            
              FIsExportRedirect := True;
          end;
          if FIsFP3 and (FFormFileName <> '') then
            RepName := FFormFileName;
          FDialogSessionId := ParseParam('sessionid');
          FCacheId := ParseParam('cacheid');
          FBrowserPrn := ParseParam('print') = '1';
          FPrn := ParseParam('prn');
          if (FPrn = '1') and ServerConfig.GetBool('server.http.allowprint') then
          begin
          // print window
            FReturnData := ServerPrinter.GetHTML(FCacheId, RepName);
            FMIMEType := 'text/html';
          end
          else
          if (FPrn = '2') and ServerConfig.GetBool('server.http.allowprint') then
          begin
{$IFDEF DELPHI12}
            ServerPrinter.AddPrintJob(FCacheId, ParseParam('printer'), Parseparam('pages'), StrToInt(ParseParam('copies')), ParseParam('collate') = '1', ParseParam('reverse') = '1');
{$ELSE}
            ServerPrinter.AddPrintJob(FCacheId, Utf8Decode(ParseParam('printer')), Parseparam('pages'), StrToInt(ParseParam('copies')), ParseParam('collate') = '1', ParseParam('reverse') = '1');
{$ENDIF}
            FName := FCacheId + '/index.html';
          end
          else
          if (RepName <> '') and ReportsList.GetGroupMembership(RepName, FGroup) then
          begin
              if Length(FDialogSessionId) > 0 then
                FDialog := True;
              s := ParseParam('format');
              if Length(s) > 0 then
              begin
                Redir := '';
                SelectFormat(s);
              end;
              Self.FmPage := ParseParam('mPage');
              s := ParseParam('multipage');
              if s = '0' then FMultipage := False
              else if s = '1' then FMultipage := True
              else FMultipage := not ServerConfig.GetBool('server.exports.html.singlepage');
              s := ParseParam('pagenav');
              if s = '0' then FPageNavigator := False
              else if s = '1' then FPageNavigator := True
              else FPageNavigator := ServerConfig.GetBool('server.exports.html.navigator');
              s := ParseParam('pagerange');
              FPageRange := s;
              if FBrowserPrn then
              begin
                FMultipage := false;
                FPageNavigator := false;
                Redir := '';
              end;

              FVariables := TfrxVariables.Create;
              try
                if Pos('=', FName) > 0 then
                begin
                  i := 1;
                  while i > 0 do
                  begin
                    j := 1;
                    while (j <= i) and (j <> 0) do
                    begin
                      i := Pos('=', FName);
                      j := Pos('&', FName);
                      if (j < i) and (j <> 0) then
                        FName := Copy(FName, j + 1, Length(FName) - j);
                    end;
                    if i > 0 then
                    begin
                      P := Copy(FName, 1, i - 1);
                      s := ParseParam(P);
{$IFDEF DELPHI12}
                      V := s;
{$ELSE}
                      V := UTF8Decode(s);
{$ENDIF}
                      if V = '' then
                        V := s;
                      V := '''' + V + '''';
                      FVariables[P] := V;
                    end;
                  end;
                end;
                if Redir = '' then
                begin
                  FIsReport := True;
                  FName := frxGetAbsPathDir(ServerConfig.GetValue('server.reports.path'), ServerConfig.ConfigFolder) + RepName;
                  FReportName := RepName;
                  PrepareReportQuery;
                end
                else
                  FName := Redir;
              finally
                FVariables.Free;
              end;
          end else
            if i > 0 then
              FErrorCode := 403;
        end else
        begin
          FReturnData := TfrxReportServer(ParentReportServer).Variables.GetValue(s);
          if Length(FReturnData) = 0 then
          begin
            UpdateLocalVariables;
            FReturnData := LocalVariables.GetValue(s);
            if Length(FReturnData) = 0 then
              FErrorCode := 404;
          end;
        end;
      end;
end;

function TfrxServerSession.ParseParam(S: String): String;
var
  i, j: integer;
  aStrResult : AnsiString;
begin
  i := Pos(UpperCase(S) + '=', UpperCase(FName));
  if i > 0 then
  begin
    aStrResult := Copy(FName, i + Length(S) + 1, Length(FName) - i + Length(S) + 1);
    j := Pos('&', aStrResult);
    if j > 0 then
      aStrResult := Copy(aStrResult, 1, j - 1);
    Delete(FName, i, Length(S) + Length(aStrResult) + 1);
  end else
    aStrResult := '';
  if Length(FName) > 0 then
  begin
    i := 1;
    while (FName[i] = '&') and (i < Length(FName)) do
      Inc(i);
    Delete(FName, 1, i - 1);
  end;
  if aStrResult <> '' then
    aStrResult := HTML2Str(aStrResult);
{$IFDEF DELPHI12}
  Result := UTF8Decode(aStrResult)
{$ELSE}
  Result := aStrResult;
{$ENDIF}
end;

function TfrxServerSession.CheckBadPath: Boolean;
begin
  Result := (Pos('..\', FName) > 0) or (Pos('../', FName) > 0);
end;

procedure TfrxServerSession.CreateReplyHTTPData;
var
  SearchRec: TSearchRec;
  s, sn: String;
  Index: Integer;
begin
  FServerReplyData.Clear;
  FReplyHeader.Clear;

  if Length(FReturnData) > 0 then
    FErrorCode := 200;

  if (FErrorCode = 0) then
    if CheckBadPath then
      FErrorCode := 403
    else if FAuthNeeded then
      FErrorCode := 401
    else if (Length(FResultPage) > 0) then
    begin

      if ((FFormat = sfHTM) or (FFormat = sfHTMD)) and (not FDialog) then
      begin
        FErrorCode := 200;
        FRedirect := False;
      end
      else

      if FileExists(FParentHTTPServer.BasePath + FResultPage) then
      begin
        FErrorCode := 301;
        FRedirect := True;
      end
    end else
    begin
      if FName = '' then
        FName := FParentHTTPServer.MainDocument;
      if (FindFirst(FParentHTTPServer.BasePath + FName, faReadOnly + faArchive, SearchRec) = 0) or
         (FindFirst(FParentHTTPServer.BasePath + FName + FParentHTTPServer.MainDocument, faReadOnly + faArchive, SearchRec) = 0)
      then
      begin
        FErrorCode := 200;
        FSize := SearchRec.Size;
        FFileDate := FileDateToDateTime(SearchRec.Time);
      end else
        FErrorCode := 404;
      FindClose(SearchRec);
    end;
  UpdateSessionFName;
  s := ExtractFileExt(FName);
  if FMIMEType = '' then
    FMIMEType := GetMime(s);
  s := '';
  if FErrorCode = 401 then
    s := ' Unauthorized'
  else if FErrorCode = 403 then
    s := ' Forbidden';
  if FData <> nil then
    FData.HTTPVer := FHTTPVersion;
  if FData <> nil then
    FData.ErrorCode := FErrorCode;
  if (FErrorCode = 0 ) and (Length(FReportMessage) > 0) then
  begin
    FErrorCode := 500;
    s := FReportMessage;
  end;
  FReplyHeader.Add(FHTTPVersion + ' ' + IntToStr(FErrorCode) + s);
  if Length(s) = 0 then
  begin
    sn := 'Server';

    FReplyHeader.Add(sn + ': ' + SERVER_NAME);
    AddOutData(sn, SERVER_NAME);

    if FErrorCode = 200 then
    begin
      sn := 'Content-Type';
      AddOutData(sn, FMIMEType);
      FReplyHeader.Add(sn + ': ' + FMIMEType);

      if FIsExportRedirect then
      begin
        sn := 'Content-Disposition';
        Index := LastDelimiter('/', FName);
        if Index = Length(FName) then
          Index := 0;  
        S := 'inline; filename="' + Copy(FName, Index + 1, Length(FName)) + '"';
        AddOutData(sn, S);
        FReplyHeader.Add(sn + ': ' + S);
        FIsExportRedirect := false;
      end;
      
    end;        
    if (FParentHTTPServer.FNoCacheHeader) and (not FRedirect) then
    begin
      sn := 'Cache-Control';
      s := 'must-revalidate, max-age=0';
      AddOutData(sn, s);
      FReplyHeader.Add(sn + ': ' + s);
      sn := 'Pragma';
      s := 'no-cache';
      AddOutData(sn, s);
      FReplyHeader.Add(sn + ': ' + s);
    end;
    sn := 'Accept-ranges';
    s := 'none';
    AddOutData(sn, s);
    FReplyHeader.Add(sn + ': ' + s);
    sn := 'Last-Modified';
    s := DateTimeToRFCDateTime(FFileDate);
    AddOutData(sn, s);
    FReplyHeader.Add(sn + ':' + s);
    sn := 'Expires';
    s := DateTimeToRFCDateTime(FFileDate);
    if FData <> nil then
    begin
      FData.Expires := FFileDate;
      FData.LastMod := FFileDate;
    end;
    AddOutData(sn, s);
    FReplyHeader.Add(sn + ':' + s);
    if FGzip and CheckDeflate(FName) and (FErrorCode = 200) and FParentReportServer.SocketOpen then
    begin
      sn := 'Content-Encoding';
      s := 'gzip';
      AddOutData(sn, s);
      FReplyHeader.Add(sn + ': ' + s)
    end else
      FGzip := False;
    if FRedirect then
    begin
      sn := 'Location';
      s := 'result?report=' + FReportName;
      if FDialogSessionId <> '' then
        s := s + '&dialog_redirect='
      else
        s := s + '&export_redirect=';
      s := s + FResultPage;
      if (not FIsFP3) then
      begin
        s := s + '&cacheid=';
        if FDialogSessionId <> '' then
          s := s + FDialogSessionId
        else
          s := s + FSessionId;
      end;
      AddOutData(sn, s);
      FReplyHeader.Add(sn + ': ' + s);
    end;
    if FIsReport then
    begin
      sn := 'SessionId';
      if FDialogSessionId <> '' then
        s := FDialogSessionId
      else
        s := SessionId;
      AddOutData(sn, s);
      FReplyHeader.Add(sn + ': ' + s);
    end;
  end;
end;

function TfrxServerSession.GetSessionPath: AnsiString;
begin
  if (FIsFP3) then
  begin
    if FContentMD5 = '' then
      FContentMD5 := MD5Stream(FStream);
    result := SID_STORE + FContentMD5;
  end
  else
    result := FSessionID;
end;

procedure TfrxServerSession.PrepareReportQuery;
var
 Path: String;
 {$IFNDEF FPC}
 SecAtrtrs: TSecurityAttributes;
 {$ENDIF}
 ReportTimeout: Integer;
 MaxReports: Integer;
begin
  if FIsReport then
  begin
    Path := FParentHTTPServer.BasePath + SessionId;
    {$IFDEF FPC}
    CreateDir(Path);
    {$ELSE}
    SecAtrtrs.nLength := SizeOf(TSecurityAttributes);
    SecAtrtrs.lpSecurityDescriptor := nil;
    SecAtrtrs.bInheritHandle := true;
    CreateDirectory(PChar(Path), @SecAtrtrs);
    {$ENDIF}
    if not FDialog then
    begin
      MaxReports := ServerConfig.GetNumber('server.reports.maxreports');
      ReportTimeout := ServerConfig.GetNumber('server.http.sockettimeout') * 1000;

      if MaxReports > 0 then
      begin
          while LogWriter.CurrentReports > MaxReports do
          begin
            if ReportTimeout = 0 then
            begin
              FErrorText := 'Maximum count of reports has been reached.';
              ErrorLog;
              exit;
            end
            else
              Dec(ReportTimeout);
            PMessages;
          end;
      end;

      FRepSession := TfrxReportSession.Create;
      FRepSession.ParentThread := Self;
      FRepSession.NativeClient := Pos('FastReport', FUserAgent) > 0;
      FRepSession.Stream := FStream;
      FRepSession.IsFP3 := FIsFP3;
      FRepSession.ParentReportServer := ParentReportServer;
      FRepSession.SessionId := SessionId;
      FRepSession.CacheId := FCacheId;
      if FIsFP3 then
      begin
        FRepSession.FileName := FContentMD5;
        FStream.Position := 0;
      end
      else
        FRepSession.FileName := FName;
      FRepSession.ReportPath := FParentHTTPServer.ReportPath;
      FRepSession.IndexFileName := FParentHTTPServer.MainDocument;
      FRepSession.RootPath := FParentHTTPServer.BasePath;
      FRepSession.PageRange := FPageRange;
      FRepSession.Format := FFormat;
      FRepSession.mPage := FmPage;
      FRepSession.Print := FBrowserPrn;
      if Assigned(ParentReportServer.OnGetVariables) then
        DoGetVariables;
      FRepSession.Variables := FVariables;
      FRepSession.FreeOnTerminate := True;

      FRepSession.Password := FPassword;
      FSessionItem.ReportThread := FRepSession;

      FRepSession.PageNav := FPageNavigator;
      FRepSession.Multipage := FMultipage;
      FRepSession.UserLogin := FLogin;
      FRepSession.UserGroup := FGroup;

      FRepSession.Resume;

    end else
    begin
      FSessionItem := SessionManager.FindSessionById(FDialogSessionId);
      if FSessionItem <> nil then
      begin
        FRepSession := FSessionItem.ReportThread;
        if FRepSession <> nil then
        begin
          FRepSession.Stream := FStream;
          FRepSession.Variables := FVariables;
          FRepSession.Continue := True;
          while FRepSession.DialogActive and (not Terminated) do
            Sleep(25);
        end;
      end;
    end;
    if (FRepSession <> nil) and (not Terminated) then
    begin
      while (not Terminated) and (FRepSession.Active) and (not FRepSession.DialogActive) do
        Sleep(10);
      if FRepSession.Active and Terminated then
      begin
        FRepSession.TerminateReport;
        // do not close session until report thread is down
        //while FRepSession.Active do
        //  Sleep(10);
      end;
      if FDialog then
        FName := PathDelim + FDialogSessionId + FRepSession.ResultPage
      else
      begin
        FName := PathDelim + SessionId + FRepSession.ResultPage;
      end;

      FReportTitle := FRepSession.ReportTitle;

      if FRepSession.Mime <> '' then
        FMIMEType := FRepSession.Mime;

      FReportMessage := FRepSession.ReportMessage;

      if FRepSession.Auth then
        FAuthNeeded := True;

      if (not FRepSession.DialogActive) then
        if FDialog then
        begin
          FRepSession.Terminate;
          PMessages;
          SessionManager.FindSessionById(FDialogSessionId).ReportThread := nil;
        end else
          SessionManager.FindSessionById(FSessionId).ReportThread := nil;
      FRepSession.Readed := True;
    end else
      FName := '';
    FResultPage := StringReplace(FName, '\', '/', [rfReplaceAll]);
    FFileDate := Now;
  end;
end;

procedure TfrxServerSession.WriteHtmlReportIndex(OutStream: TfrxSSIStream);
var
  FTemplate: TfrxServerTemplate;
  s, Template: String;
  AnsiStr: AnsiString;
begin
  Template := '';
  FTemplate := TfrxServerTemplate.Create;
  try
    FTemplate.SetTemplate('index');
    FTemplate.Variables.AddVariable('TITLE', FReportTitle);
    FTemplate.Variables.AddVariable('SESSION', FSessionId);
    if FMultipage then
      s := '1.html'
    else
    if FPageNavigator then
      s := 'main.html'
    else
      s := 'html';

    // /FastReport.Export.axd?object=
    FTemplate.Variables.AddVariable('INDEX', '/' + SessionId + '/index.' + s);
    FTemplate.Prepare;
    Template := FTemplate.TemplateStrings.Text;
  finally
    FTemplate.Free;
  end;
  AnsiStr := UTF8Encode(Template);
  OutStream.Write(AnsiStr[1], Length(AnsiStr));  // check
end;

procedure TfrxServerSession.MakeServerReply;
var
  FStream: TFileStream;
  Buffer, sn, s: AnsiString;
  i: Integer;
  MemStream, MemStreamOut: TMemoryStream;
  FSSIStream: TfrxSSIStream;
  FTemplate: TfrxServerTemplate;
{$IFDEf Delphi12}
  TempStr: AnsiString;
{$ENDIF}
  crit: TfrxMutex;
begin
  if FData <> nil then
    FData.FileName := FName;
  if FErrorCode = 200 then
  begin
    if ClientSocket.Connected or (not FParentReportServer.SocketOpen) then
    begin
      MemStream := TMemoryStream.Create;
      FSSIStream := TfrxSSIStream.Create;
      FSSIStream.BasePath := FParentHTTPServer.BasePath;
      FSSIStream.Variables := FParentReportServer.Variables;
      UpdateLocalVariables;
      FSSIStream.LocalVariables := LocalVariables;
      try
        try
          if Length(FReturnData) = 0 then
          begin
            if FIsReport and (Pos('form', FName) = 0) and ((FFormat = sfHTM) or (FFormat = sfHTMD)) then
            begin
              WriteHtmlReportIndex(FSSIStream);
            end
            else
            begin
              crit := TfrxMutex.Create(FName);
              crit.Lock;
              FStream := TFileStream.Create(FParentHTTPServer.BasePath + FName, fmOpenRead + fmShareDenyWrite);
              try
                FSSIStream.CopyFrom(FStream, 0);
              finally
                FStream.Free;
                crit.Unlock;
                crit.Free;
              end;
              if CheckSSI(FName) then
                FSSIStream.Prepare
            end
          end
          else
            FSSIStream.Write(FReturnData[1], Length(FReturnData)); // check

          FSSIStream.Position := 0;
          if FGzip and FParentReportServer.SocketOpen then
          begin
            try
              frxCompressStream(FSSIStream, MemStream, gzMax, FName);
            except
              on E:Exception do
              begin
                FErrorText := 'GZIP pack error. ' + E.Message;
                ErrorLog;
              end;
            end;
          end else
            MemStream.CopyFrom(FSSIStream, 0);
          MemStream.Position := 0;
          sn := 'Content-length';
          s := IntToStr(MemStream.Size);
          AddOutData(sn, s);
          FReplyHeader.Add(sn + ': ' + s);
          if FKeepAlive then
            FReplyHeader.Add('Connection: Keep-Alive')
          else
            FReplyHeader.Add('Connection: Close');
          if ServerConfig.GetBool('server.http.mic') then
          begin
            sn := 'Content-MD5';
            s := MD5Stream(MemStream);
            AddOutData(sn, s);
            FReplyHeader.Add(sn + ': ' + s);
          end;
          FReplyHeader.Add('X-Powered-By: FastReportServer/' + SERVER_VERSION);

          if ((Pos('sid_', FName) > 0) or (Pos('store_', FName) > 0)) then
          begin
            s := 'frreport';
            FReplyHeader.Add('FastReport-container:' + s);
          end;

          FReplyHeader.Add('');
          Buffer := FReplyHeader.Text;
        except
          on E:Exception do
          begin
            FErrorText := 'error prepare output result ' + E.Message;
            ErrorLog;
          end;
        end;
        if FParentReportServer.SocketOpen then
        begin
          MemStreamOut := TMemoryStream.Create;
          try
            MemStream.SaveToStream(MemStreamOut);
            MemStreamOut.Position := 0;

            ClientSocket.SendBuf(Buffer[1], Length(Buffer));  // check
            ClientSocket.SendStreamThenDrop(MemStreamOut);
          except
            on E:Exception do
            begin
              MemStreamOut.Free;
              FErrorText := 'error socket stream output result' + E.Message;
              ErrorLog;
            end;
          end;
        end else
        begin
          FData.RepHeader := Buffer;
          FData.Stream.CopyFrom(MemStream, 0);
        end;
      finally
        MemStream.Free;
        FSSIStream.Free;
      end
    end;
  end else
  begin
    sn := 'Content-Type';
    s := 'text/html';
    AddOutData(sn, s);
    FReplyHeader.Add(sn + ': ' + s);

    if FErrorCode = 404 then
    begin
      FTemplate := TfrxServerTemplate.Create;
      try
        FTemplate.SetTemplate('error404');
        FTemplate.Variables.AddVariable('ERROR', FReportMessage + '<br>' + ServerConfig.ServerMessage);
        FTemplate.Prepare;
        Buffer := FTemplate.TemplateStrings.Text;
      finally
        FTemplate.Free;
      end;

      i := Length(Buffer);
      FErrorText := FName + ' document not found ' + FReportMessage;
      ErrorLog;
    end else
    if FRedirect or (FErrorCode = 403) then
    begin
      i := 0;
      Buffer := '';
    end else
    if FErrorCode = 401 then
    begin
      i := 0;
      Buffer := '';
      if FAuthInProgress then
        FReplyHeader.Add(Format('WWW-Authenticate: ' + FAuthType + ' %s', [FAuthResponse]))
      else
      begin
        if ServerConfig.GetBool('server.security.winauth') then
        begin
          FReplyHeader.Add('WWW-Authenticate: NTLM');
          FReplyHeader.Add('WWW-Authenticate: Negotiate');
          FReplyHeader.Add('WWW-Authenticate: Kerberos');
          FKeepAlive := True;
        end
        else
        begin
          sn := 'WWW-Authenticate';
          s := 'Basic realm="' + SERVER_NAME + '"';
          AddOutData(sn, s);
          FReplyHeader.Add(sn + ': ' + s);
        end;
      end;
    end else
    begin
      FTemplate := TfrxServerTemplate.Create;
      try
        FTemplate.SetTemplate('error500');
        FTemplate.Variables.AddVariable('ERROR', '');
        FTemplate.Prepare;
        Buffer := FTemplate.TemplateStrings.Text;
      finally
        FTemplate.Free;
      end;
      i := Length(Buffer);
      FErrorText := 'unknown error';
      ErrorLog;
    end;

    if FKeepAlive then
      FReplyHeader.Add('Connection: Keep-Alive')
    else
      FReplyHeader.Add('Connection: Close');

    sn := 'Content-length';
    s := IntToStr(i);
    AddOutData(sn, s);
    FReplyHeader.Add(sn + ': ' + s);
    FReplyHeader.Add('');
//    Buffer := FReplyHeader.Text + Buffer;
    if FParentReportServer.SocketOpen then
    begin
      try
{$IFDEF Delphi12}
        TempStr := AnsiString(FReplyHeader.Text);
        ClientSocket.SendText(TempStr);
{$ELSE}

        ClientSocket.SendText(FReplyHeader.Text);
{$ENDIF}
        ClientSocket.SendText(Buffer);
        if not FKeepAlive then
          ClientSocket.Close;
      except
        on E: Exception do
        begin
          FErrorText := 'error socket stream output answer. ' + E.Message;
          ErrorLog;
        end;
      end;
    end else
    begin
      FData.RepHeader := FReplyHeader.Text;
      FData.Stream.Write(Buffer[1], Length(Buffer)); // check
    end;
  end;
end;

procedure TfrxServerSession.ClientExecute;
var
  FDSet: TFDSet;
  TimeVal: TTimeVal;
  TempStream, TempStream1: TMemoryStream;
  i: Integer;
  Len, HeaderEnd: Integer;
  HeaderParsed: Boolean;

  function SearchHeaderEnd(Strm: TMemoryStream; StartPos: Integer): Integer;
  var
    ptrByte: PAnsiChar;
  begin
    ptrByte := Strm.Memory;
    if StartPos < 0 then
      StartPos := 0;
    Result := -1;
    while StartPos < Strm.Size - 3 do
    begin
      if (ptrByte[StartPos] = #13) and (ptrByte[StartPos + 1] = #10) and (ptrByte[StartPos + 2] = #13) and (ptrByte[StartPos + 3] = #10) then
      begin
        Result := StartPos;
        Break;
      end;
      Inc(StartPos);
    end;
  end;

  function SearchStringInStream(Strm: TMemoryStream; StartPos: Integer; aString: AnsiString): Integer;
  var
    ptrByte: PAnsiChar;
    i, Reslen: Integer;
  begin
    Reslen := 0;
    ptrByte := Strm.Memory;
    if StartPos < 0 then
      StartPos := 0;
    while StartPos < Strm.Size - 3 do
    begin
      Reslen := 0;
      for i := 1 to Length(aString) do
      if (ptrByte[StartPos + i - 1] = aString[i]) then
        Inc(Reslen)
      else break;
      if Reslen = Length(aString) then Break;
      Inc(StartPos);
    end;
    Result := -1;
    if Reslen = Length(aString) then
      Result := StartPos;
  end;

  procedure ReadHeader(aHeaderLen: Integer; aStream: TStream);
  var
    OldPos: Integer;
  begin
    SetLength(FHeader, aHeaderLen);
    try
      OldPos := TempStream.Position;
      TempStream.Position := 0;
      TempStream.ReadBuffer(FHeader[1], aHeaderLen); // check
      TempStream.Position := OldPos;
      ParseHTTPHeader;
    except
      on E: Exception do
      begin
        FErrorText := 'error client stream parsing. ' + E.Message;
        ErrorLog;
      end;
    end;
    HeaderParsed := true;
  end;

  procedure GetDataFromBoundary(sPos: Integer);
  var
    i: Integer;
    ContentDisp, ContentType: AnsiString;
    ParamName, lFileName, lHeader: AnsiString;

    function GetValue(aStr: AnsiString; aName: AnsiString): AnsiString;
    var
      i, sPos: Integer;
    begin
      Result := '';
      sPos := Pos(aName + '="', aStr);
      if sPos < 1 then Exit;
      Inc(sPos, length(aName) + 2);
      i := sPos;
      while i <= Length(aStr) do
      begin
        if aStr[i] = '"' then break;
        Inc(i);
      end;
      Result := Copy(aStr, sPos, i - sPos);
    end;

  begin
    sPos := SearchStringInStream(TempStream, sPos, '--' + FBoundary);
    if sPos <> -1 then
    begin
      Inc(sPos, Length(FBoundary) + 2);
      i := SearchHeaderEnd(TempStream, sPos);
      if i <> -1 then
      begin
        SetLength(lHeader, i - sPos + 4);
        TempStream.Position := sPos;
        TempStream.ReadBuffer(lHeader[1], i - sPos + 4);

        ContentDisp := ParseHeaderField('Content-Disposition: ', lHeader);
        ContentType := ParseHeaderField('Content-Type: ', lHeader);

        ParamName := GetValue(ContentDisp, 'name');
        if ParamName = '0' then
          FFormFileName := ParamName
        else
        begin
          lFileName := ExtractFileName(GetValue(ContentDisp, 'filename'));
          SelectFormat(ParamName);
          if lFileName <> '' then
            FFormFileName := lFileName
        end;
        //IsFP3Content(ContentType);  //not need trash?
        sPos := i + 4;
        TempStream.Position := sPos;
        i := SearchStringInStream(TempStream, sPos, '--' + FBoundary) - 1;
        Len := i - 1 - TempStream.Position;
        if i <> -1 then
          FStream.CopyFrom(TempStream, Len);
      end;
    end;
    if (FContentMD5 <> '') then
    begin
      FIsFP3 := True;
      ParamName := ParseHeaderField('Format-Export: ');
      FFormFileName := 'NoInReport.fp3';
      SelectFormat(ParamName);
    end;
  end;

begin
  HeaderParsed := False;
  LogWriter.StatAddCurrentSession;
  FIsExportRedirect := False;
  if FParentReportServer.SocketOpen then
  begin
    FD_ZERO(FDSet);
    FD_SET(ClientSocket.SocketHandle, FDSet);
    TimeVal.tv_sec := FParentHTTPServer.SocketTimeOut;
    TimeVal.tv_usec := 0;
    repeat
{$IFDEF CS_ON}
      ServCS.Enter;
      try
{$ENDIF}
      {$IFNDEF Linux}
        i := select(0, @FDSet, nil, nil, @TimeVal);
      {$ELSE}
        i := select(ClientSocket.SocketHandle + 1, @FDSet, nil, nil, @TimeVal);
      {$ENDIF}
{$IFDEF CS_ON}
      finally
        ServCS.Leave;
      end;
{$ENDIF}
      if i = -1 then
        FKeepAlive := False;
      if (i > 0) and not Terminated then
      begin
        TempStream := TMemoryStream.Create;
        TempStream1 := TMemoryStream.Create;
        HeaderEnd := -1;
        Len := 0;
        try
          i := ClientSocket.ReceiveLength;
          try
            while (i <> 0) or (FContentLength > TempStream.Size - Len) do
            begin
              TempStream1.SetSize(i);
              ClientSocket.ReceiveBuf(TempStream1.Memory^, i);
              i := ClientSocket.ReceiveLength;
              TempStream.CopyFrom(TempStream1, 0);
              if HeaderEnd = -1 then
                HeaderEnd := SearchHeaderEnd(TempStream, TempStream.Size - TempStream1.Size - 4);
              if (not HeaderParsed) and (HeaderEnd > 0) then
              begin
                Len := HeaderEnd + 3;
                ReadHeader(Len, TempStream);
              end;

              if not HeaderParsed and (TempStream.Size > FParentHTTPServer.FMaxHTTPHeaderSize) or
                 HeaderParsed and (Len > FParentHTTPServer.FMaxHTTPHeaderSize)then
                raise Exception.Create('HTTP header is too large.');

              if HeaderParsed and (FParentHTTPServer.FMaxContentSize > 0) and
                (((FContentLength > 0) and (FContentLength > FParentHTTPServer.FMaxContentSize)) or
                (TempStream.Size - Len > FParentHTTPServer.FMaxContentSize)) then
                raise Exception.Create('HTTP content size is greater than allowed.');

              if (FContentMD5 <> '') and ReportCache.IsReportInCache(FContentMD5, nil, '') then
                break;
            end;
          except
            on E: Exception do
            begin
              FErrorText := 'error socket stream read.' + E.Message;
              ErrorLog;
            end;
          end;

          TempStream.Position := 0;
          i := StreamSearch(TempStream, 0, #13#10#13#10);
          if i <> -1 then
          begin
            Len := i + 4;
            if not HeaderParsed then
              ReadHeader(Len, TempStream);
            try
              if FBoundary <> '' then
                GetDataFromBoundary(Len)
              else
              begin
                TempStream.Position := Len;
                FStream.CopyFrom(TempStream, TempStream.Size - Len);
              end;
            except
              on E: Exception do
              begin
                FErrorText := 'error client query.' + E.Message;
                ErrorLog;
              end;
            end;
          end;
        finally
          TempStream.Free;
          TempStream1.Free;
        end;
      end;
{$IFDEF CS_ON}
      ServCS.Enter;
      try
{$ENDIF}
      {$IFNDEF Linux}
        i := select(0, nil, @FDSet, nil, @TimeVal);
      {$ELSE}
        i := select(ClientSocket.SocketHandle + 1, nil, @FDSet, nil, @TimeVal);
      {$ENDIF}
{$IFDEF CS_ON}
      finally
        ServCS.Leave;
      end;
{$ENDIF}
      if (i > 0) and not Terminated then
        if (Length(FHeader) > 0) and ClientSocket.Connected then
        begin
          ParseParameters;
          CreateReplyHTTPData;
          MakeServerReply;
        end;
    until not FKeepAlive;
    CloseSession;
  end
  else
  begin
    if FData.Stream.Size > 0 then
    begin
      FStream.CopyFrom(FData.Stream, 0);
      FData.Stream.Clear;
    end;
    FHeader := FData.Header;
    ParseHTTPHeader;
    ParseParameters;
    CreateReplyHTTPData;
    MakeServerReply;
    FActive := False;
    Sleep(100);
  end;
  LogWriter.StatRemoveCurrentSession;
end;

procedure TfrxServerSession.WriteLogs;
begin
  LogWriter.Write(ACCESS_LEVEL, DateTimeToStr(Now) + #9 + SessionId + #9 + FRemoteIP + #9 + FName);
  if Length(FReferer) > 0 then
    LogWriter.Write(REFERER_LEVEL, DateTimeToStr(Now) + #9 + FRemoteIP + #9 + FReferer);
  if Length(FUserAgent) > 0 then
    LogWriter.Write(AGENT_LEVEL, DateTimeToStr(Now) + #9 + FRemoteIP + #9 + FUserAgent);
end;

procedure TfrxServerSession.ErrorLog;
begin
  LogWriter.Write(ERROR_LEVEL, DateTimeToStr(Now) + #9 + FRemoteIP + #9 + FErrorText);
  LogWriter.ErrorReached;
end;

procedure TfrxServerSession.UpdateSessionFName;
begin
  SessionManager.FindSessionById(FSessionId).FileName := FName;
end;

procedure TfrxServerSession.CloseSession;
begin
  SessionManager.CompleteSessionId(SessionId);
end;

function TfrxServerSession.CheckSSI(FileName: String): Boolean;
var
  ext: String;
begin
  ext := LowerCase(ExtractFileExt(FileName));
  Result := (ext = '.htm') or (ext = '.html') or
            (ext = '.shtm') or (ext = '.shtml');
end;

function TfrxServerSession.CheckDeflate(FileName: String): Boolean;
var
  ext: String;
begin
  ext := LowerCase(ExtractFileExt(FileName));
  if Pos('MSIE', FUserAgent) > 0 then
    Result := ((ext = '.htm') or (ext = '.html') or
              (ext = '.shtm') or (ext = '.shtml') or
              (ext = '.css') or (ext = '.txt') or
              (ext = '.bmp')) and (FSize > MAX_IE_GZIP)
  else
    Result := (ext <> '.jpg') and (ext <> '.jpeg') and
              (ext <> '.gif') and (ext <> '.png') and
              (ext <> '.ods') and (ext <> '.odt') and
              (ext <> '.zip') and (ext <> '.rar');
end;

function TfrxServerSession.InitAuth(const SecPackageName: String): boolean;
{$IFNDEF Linux}
var
  ntlmSecPI: PSecPkgInfo;
{$ENDIF}
begin
  Result := false;
  {$IFNDEF Linux}
  if QuerySecurityPackageInfo(PChar(SecPackageName),ntlmSecPI) = 0 then
  begin
    FMaxTokenSize := ntlmSecPI^.cbMaxToken;
    FreeContextBuffer(ntlmSecPI);
    if AcquireCredentialsHandle(nil, PChar(SecPackageName),
      SECPKG_CRED_INBOUND, nil, nil, nil, nil, @FCredHandle, FExpire) = 0 then
      Result:=true;
  end;
  {$ENDIF}
end;

procedure TfrxServerSession.IsFP3Content(aContent: AnsiString);
begin
  FIsFP3 := not(Pos('FastReport', FUserAgent) > 0) and
    ((Pos('application/octet-stream', aContent) > 0) or
    (Pos('multipart/form-data; boundary', aContent) > 0) or
    (Pos('application/xml', aContent) > 0) or
    (Pos('application/zip', aContent) > 0));
  FIsFP3 := FIsFP3 or (Pos('application/fp3', aContent) > 0);
end;

procedure TfrxServerSession.FinalAuth;
begin
  {$IFNDEF Linux}
  FreeCredentialsHandle(@FCredHandle);
  {$ENDIF}
end;

function TfrxServerSession.ProcessAuthRequest(AuthRequest: AnsiString; NewConversation: boolean; var AuthResponse: AnsiString;
  var ContextHandle: TSecHandle; var AuthFinished: boolean): boolean;
var
  InBufD: TSecBufferDesc;
  InBuf: TSecBuffer;
  OutBufD: TSecBufferDesc;
  OutBuf: TSecBuffer;
  Attribs: cardinal;
  R: integer;
  Context: PCtxtHandle;
begin
  Result := false;
  // prepare input buffer
  AuthRequest := Base64Decode(AuthRequest);
  inBufD.ulVersion := SECBUFFER_VERSION;
  inBufD.cBuffers := 1;
  inBufD.pBuffers := @inBuf;
  inBuf.BufferType := SECBUFFER_TOKEN;
  inBuf.cbBuffer := length(AuthRequest);
  inBuf.pvBuffer := AllocMem(inBuf.cbBuffer);
  Move(AuthRequest[1], inBuf.pvBuffer^, inBuf.cbBuffer);
  // prepare output buffer
  outBufD.ulVersion := SECBUFFER_VERSION;
  outBufD.cBuffers := 1;
  outBufD.pBuffers := @outBuf;
  outBuf.BufferType := SECBUFFER_TOKEN;
  outBuf.cbBuffer := FMaxTokenSize;
  outBuf.pvBuffer := AllocMem(outBuf.cbBuffer);
  // process request
  if NewConversation then
    Context := nil
  else
    Context := @ContextHandle;
  Attribs := 0;
  {$IFNDEF Linux}
  R := AcceptSecurityContext(@FCredHandle, Context, @inBufD, Attribs, SECURITY_NATIVE_DREP, @ContextHandle,
    @outBufD, Attribs, @FExpire);
  if (R = SEC_I_COMPLETE_NEEDED) or (R = SEC_I_COMPLETE_AND_CONTINUE) then
    if CompleteAuthToken(@ContextHandle, @outBufD) <> 0 then
      exit;
  {$ENDIF}
  AuthFinished := not((R = SEC_I_CONTINUE_NEEDED) or (R = SEC_I_COMPLETE_AND_CONTINUE));
  SetLength(AuthResponse, outBuf.cbBuffer);
  Move(outBuf.pvBuffer^, AuthResponse[1], outBuf.cbBuffer);
  AuthResponse := Base64Encode(AuthResponse);
  // free buffers
  FreeMem(inBuf.pvBuffer);
  FreeMem(outBuf.pvBuffer);
  Result := true;
end;

procedure TfrxServerSession.SelectFormat(FormatName: String);
begin
  if Length(FormatName) > 0 then
  begin
    FormatName := UpperCase(FormatName);
    if FormatName = 'PDF' then FFormat := sfPDF else
    if FormatName = 'ODS' then FFormat := sfODS else
    if FormatName = 'ODT' then FFormat := sfODT else
    if FormatName = 'XML' then FFormat := sfXML else
    if FormatName = 'XLS' then FFormat := sfXLS else
    if FormatName = 'RTF' then FFormat := sfRTF else
    if FormatName = 'TXT' then FFormat := sfTXT else
    if FormatName = 'CSV' then FFormat := sfCSV else
    if FormatName = 'JPG' then FFormat := sfJPG else
    if FormatName = 'BMP' then FFormat := sfBMP else
    if FormatName = 'GIF' then FFormat := sfGIF else
    if (FormatName = 'TIFF') or (FormatName = 'TIF') then FFormat := sfTIFF else
    if (FormatName = 'FRP') or (FormatName = 'FP3') then FFormat := sfFRP else
    if (FormatName = 'HTML') or (FormatName = 'HTM') then FFormat := sfHTM else
    FFormat := sfHTMD;
  end;
end;

function TfrxServerSession.GetCurrentUserToken: {$IFDEF DEL16ORFPC} THandle {$ELSE} cardinal {$ENDIF};
begin
  {$IFNDEF Linux}
  if not OpenThreadToken(GetCurrentThread, TOKEN_READ or
    TOKEN_DUPLICATE or TOKEN_IMPERSONATE, true, Result) then
    if not OpenProcessToken(GetCurrentProcess, TOKEN_READ or
      TOKEN_DUPLICATE or TOKEN_IMPERSONATE, Result) then
  {$ENDIF}
      Result := 0;
end;


procedure TfrxServerSession.CheckAuth;
var
  i: Integer;
  s: AnsiString;
  L, P: AnsiString;
  sz: cardinal;

begin
  FAuthNeeded := ((Length(ServerConfig.GetValue('server.security.login')) > 0) and
     (Length(ServerConfig.GetValue('server.security.password')) > 0))
     or (ServerConfig.GetBool('server.security.userauth'));
  s := ParseHeaderField('Authorization: ');
  if Length(s) > 0 then
  begin
    FKeepAlive := True;
    i := Pos('Basic ', s);
    if (i > 0) and  not ServerConfig.GetBool('server.security.winauth') then
    begin
      FKeepAlive := False;
      s := Copy(s, i + 6, Length(s) - i - 5);
      s := Base64Decode(s);
      i := Pos(':', s);
      if i > 0 then
      begin
        L := Copy(s, 1, i - 1);
        P := Copy(s, i + 1, Length(s) - i);
        FLogin := L;
        FPassword := P;

        if ServerConfig.GetBool('server.security.userauth') then
        begin
          FAuthNeeded := not ServerUsers.AllowLogin(L, P);
          if FName = '' then
            FName := ServerUsers.GetUserIndex(L);
          FGroup := ServerUsers.GetGroupOfUser(L);
        end
        else
        if (L = ServerConfig.GetValue('server.security.login')) and
           (P = ServerConfig.GetValue('server.security.password')) then
          FAuthNeeded := False
      end;
    end else
    begin
      // not basic auth
      i := Pos(' ', s);
      if i = 0 then
        i := Length(s);
      FAuthType := Copy(s, 1, i - 1);
      s := Copy(s, i + 1, Length(s) - i);

      if (Pos('Negotiate', FAuthType) > 0 ) or (Pos('Kerberos', FAuthType) > 0) or (Pos('NTLM', FAuthType) > 0 ) and not FAuthFinished then
      begin
        if FAuthNewConv then
        begin
          FAuthInProgress := true;
          if not InitAuth(FAuthType) then
            exit;
        end;
        if not ProcessAuthRequest(s, FAuthNewConv, FAuthResponse, FContextHandle, FAuthFinished) then
        begin
          FinalAuth;
          exit;
        end;
        FAuthNewConv := false;
        if FAuthFinished then
        begin
          {$IFNDEF Linux}
          if ImpersonateSecurityContext(@FContextHandle) <> 0 then
            exit;
          sz := 0;
          GetUserNameEx(NameSamCompatible, nil, sz);
          if sz = 0 then
            exit;
          SetLength(FLogin, sz);
          GetUserNameEx(NameSamCompatible, pointer(FLogin), sz);
          FLogin := string(PChar(FLogin));
          FPassword := '';
          if FToken <> 0 then
            CloseHandle(FToken);
          FToken := GetCurrentUserToken;
          if RevertSecurityContext(@FContextHandle) <> 0 then
            exit;
          FinalAuth;
          {$ENDIF}
          FAuthNewConv := True;
          FAuthInProgress := False;
          FAuthFinished := False;
          FAuthNeeded := False;
          FKeepAlive := False;
        end;
      end;
    end;
  end;
end;

procedure TfrxServerSession.DoGetVariables;
begin
  ParentReportServer.OnGetVariables(FName, FVariables, FLogin);
end;

procedure TfrxServerSession.AddOutData(const Name: String; const Value: String);
begin
  if FData <> nil then
    FData.OutParams.Add(Name + '=' + Value);
end;

procedure TfrxServerSession.UpdateLocalVariables;
var
  ReportsListHtml, ReportsListLines: AnsiString;

begin
  if ServerConfig.GetBool('server.security.reportslist') then
  begin
    ReportsListHtml := '';
    ReportsListLines := '';
    ReportsList.GetReports4Group(FGroup, ReportsListHtml, ReportsListLines);
    FLocalVariables.AddVariable('SERVER_REPORTS_LIST', ReportsListLines);
    FLocalVariables.AddVariable('SERVER_REPORTS_HTML', ReportsListHtml);
  end;
end;

function TfrxServerSession.GetMime(s: String): String;
begin
  result := ServerConfig.GetValue('server.exports' + LowerCase(s) + '.mimetype');
  if result = '' then
    result := GetFileMIMEType(s);
end;

{ TfrxServerData }

procedure TfrxServerData.Assign(Source: TfrxServerData);
begin
  FInParams.Assign(Source.InParams);
  FOutParams.Assign(Source.FOutParams);
  FErrorCode := Source.ErrorCode;
  FStream.Clear;
  if Source.Stream.Size > 0 then
  begin
    Source.Stream.Position := 0;
    FStream.CopyFrom(Source.Stream, 0);
  end;
  FErrorCode := Source.ErrorCode;
  FFileName := Source.FileName;
end;

constructor TfrxServerData.Create;
begin
  FInParams := TStringList.Create;
  FOutParams := TStringList.Create;
  FStream := TMemoryStream.Create;
  FErrorCode := 0;
end;

destructor TfrxServerData.Destroy;
begin
  FStream.Free;
  FInParams.Free;
  FOutParams.Free;
  inherited;
end;

{ TfrxServerGuard }

constructor TfrxServerGuard.Create(Server: TfrxReportServer);
begin
  inherited Create(True);
  FServer := Server;
  FTImeOut := ServerConfig.GetNumber('server.http.configrenewtimeout');
  if FTimeOut = 0 then
    FTimeOut := 30;
  FListTimeOut := ServerConfig.GetNumber('server.reports.reportslistrenewtimeout');
  if FListTimeOut = 0  then
    FListTimeOut := 180;
  Priority := tpLowest;
  Resume;
end;

destructor TfrxServerGuard.Destroy;
begin
  Sleep(100);
  inherited;
end;

procedure TfrxServerGuard.DoLoadConf;
begin
  FServer.LoadConfigs;
end;

procedure TfrxServerGuard.Execute;
var
  time1, time2, out1, out2: Cardinal;
begin
  time1 := GetTickCount;
  time2 := time1;
  out1 := FTimeOut * 1000;
  out2 := FListTimeOut * 1000;
  while not Terminated do
  begin
    if (GetTickCount - time1) > out1 then
    begin
//      Synchronize(DoLoadConf);
      DoLoadConf;
      time1 := GetTickCount;
    end;
    if ((GetTickCount - time2) > out2) and ServerConfig.GetBool('server.security.reportslist') then
    begin
      ReportsList.BuildListOfReports;
      time2 := GetTickCount;
    end;
    Sleep(5000);
    PMessages;
  end;
end;

initialization
  ServCS := TCriticalSection.Create;
{$IFNDEF FPC}
  frxDisableThreadSynchronizer := True;
{$ENDIF}

finalization
  ServCS.Free;

end.