rtcsrvmodule.pas

来自「Delphi快速开发Web Server」· PAS 代码 · 共 1,960 行 · 第 1/4 页

{
  @html(<b>)
  Server Module for Remote Functions
  @html(</b>)
  - Copyright (c) Danijel Tkalcec
  @html(<br><br>)

  This unit introduces @Link(TRtcServerModule), a server-side component for ENABLING remote functions.
  Implementing RTC Remote Functions is as easy as writing local functions.
}

unit rtcSrvModule;

{$INCLUDE rtcDefs.inc}

interface

uses
  rtcTrashcan,
  
  Classes,
  SysUtils,

  memBinList,

  rtcSyncObjs,
  rtcThrPool,
  rtcTimer,
  rtcInfo,
  rtcConn,
  rtcCrypt,

{$IFDEF COMPRESS}
  rtcZLib,
{$ENDIF}

  rtcFastStrings,
  rtcDataSrv,
  rtcFunction;

const
  // @exclude
  RTC_SERVERMODULE_DELAYED_CALL:string='$RTC_SERVERMODULE_DELAYED_CALL$';

type
  // @exclude
  TRtcCryptServer=class(TRtcObject)
  public
    HaveHello,HaveStart:boolean;
    ControlCounter:integer;
    ClientHello,ServerHello,
    ClientKey,ServerKey,
    ControlKey:string;

    Read,Write:TRtcCrypt;

    destructor Destroy; override;

    procedure Init;
    procedure Kill; override;
    end;

  { @abstract(Delayed Function Call object)
    Thos object is returned from the PrepareDelayedCall function and
    can be used to Wake up the delayed call. The only method you are
    allowed to use on this object is "WakeUp", and this one may
    only be called once, after which you have to "forget" about that object
    (set your variable's pointer to NIL), so you don't go and call it often. }
  TRtcDelayedCall = class(TRtcObject)
  protected
    SessionID:string;
    crypt:TRtcCryptServer;
    output:TRtcHugeString;
    {$IFDEF COMPRESS}
    Compress:TRtcCompressLevel;
    {$ENDIF}
    FMT:TRtcDataFormat;

    msDelay:integer;
    Param:TRtcFunctionInfo;
    CallEvent:TRtcFunctionCallEvent;
    AutoSessionsLive:integer;

    Called:boolean;
    Timer:TRtcTimer;
    WaitEvent:TRtcEvent;
    Conn:TRtcConnection;

    procedure Post(Multi_Threaded:boolean);

    procedure Execute;

    procedure Cancel;

  public
    // @exclude
    constructor Create;
    // @exclude
    destructor Destroy; override;

    // @exclude
    procedure Kill; override;

    // Use this method to wake the delayed call up,
    // so it will be called NOW! instead of when the timeout period has expired.
    procedure WakeUp;
    end;

  // @exclude
  EDelayedCall = class(EAbort)
  public
    call:TRtcDelayedCall;
    end;

  { @abstract(Accepts the request and uses a TRtcFunctionGroup component to
    execute received functions and prepares the result)

    ModuleProvider is the Remote Object execution point, that enables the Client(s) to
    send one or more objects to the server and get executed object(s) as a result.
    If there are any function calls found inside the objects received, those functions
    will be executed, so that the resulting object contains only data. That resulting
    object (or a set of objects) will be sent back to the client who sent the request.
    In case of an exception, execution will be aborted and the last object sent to the
    client will be an exception message: isType = rtc_Exception; asException = error message; @html(<br><br>)

    Raising an exception in any event implemented for the Module Provider,
    will result in sending an Exception object back to the client. }
  TRtcServerModule=class(TRtcAbsDataServerLink)
  private
    FFunctions:TRtcFunctionGroup;
    FModuleFileName:string;
    FModuleHost:string;
    FAutoSessionsLive: integer;
    FAutoSessionsLock: TRtcSessionLockType;

    FOnListenStart:TRtcNotifyEvent;
    FOnListenStop:TRtcNotifyEvent;
    FOnRequestAccepted:TRtcNotifyEvent;
    FOnResponseDone:TRtcNotifyEvent;
    FOnDisconnect:TRtcNotifyEvent;
    FOnSessionOpen:TRtcNotifyEvent;
    FOnSessionClose:TRtcNotifyEvent;

    FAutoEncrypt: integer;
    FForceEncrypt: boolean;
    FSecureKey: string;
    FAutoSessions: boolean;
    {$IFDEF COMPRESS}
    FCompress: TRtcCompressLevel;
    {$ENDIF}

    FDataFormats: TRtcDataFormatSupport;

    function GetCrypt(Session:TRtcSession):TRtcCryptServer;
    procedure NewCrypt(Session:TRtcSession);
    procedure DelCrypt(Session:TRtcSession);

    function GetFunctionGroup: TRtcFunctionGroup;
    procedure SetFunctionGroup(const Value: TRtcFunctionGroup);
    function GetModuleFileName: string;
    procedure SetModuleFileName(const Value: string);
    function GetModuleHost: string;
    procedure SetModuleHost(const Value: string);
    procedure SetAutoEncrypt(const Value: integer);
    procedure SetAutoSessions(const Value: boolean);
    procedure SetForceEncrypt(const Value: boolean);
    {$IFDEF COMPRESS}
    procedure SetCompress(const Value: TRtcCompressLevel);
    {$ENDIF}
    procedure SetAutoSessionsLock(const Value: TRtcSessionLockType);

  protected
    // @exclude
    procedure Call_ListenStart(Sender:TRtcConnection); override;
    // @exclude
    procedure Call_ListenStop(Sender:TRtcConnection); override;

    // @exclude
    procedure Call_SessionOpen(Sender:TRtcConnection); override;
    // @exclude
    procedure Call_SessionClose(Sender:TRtcConnection); override;

    // @exclude
    procedure Call_CheckRequest(Sender:TRtcConnection); override;
    // @exclude
    procedure Call_RequestAccepted(Sender:TRtcConnection); override;
    // @exclude
    procedure Call_ResponseDone(Sender:TRtcConnection); override;

    // @exclude
    procedure Call_DataReceived(Sender:TRtcConnection); override;
    // @exclude
    procedure Call_DataOut(Sender:TRtcConnection); override;
    // @exclude
    procedure Call_DataIn(Sender:TRtcConnection); override;
    // @exclude
    procedure Call_DataSent(Sender:TRtcConnection); override;
    // @exclude
    procedure Call_ReadyToSend(Sender:TRtcConnection); override;
    // @exclude
    procedure Call_Disconnect(Sender:TRtcConnection); override;

  public
    // @exclude
    constructor Create(AOwner:TComponent); override;
    // @exclude
    destructor Destroy; override;

  published
    {$IFDEF COMPRESS}
    { Use this property to define what compression level you want to use when sending
      data from Server to client. Default Compression value is "cNone" (no compression).
      You can use different compression levels between client and server (for example,
      fast or no compression from client and max from server). If your server has to
      work with clients which don't support compression, you have to use "cNone". }
    property Compression:TRtcCompressLevel read FCompress write SetCompress default cNone;
    {$ENDIF}

    {  Use this property to define what Data Formats you want to accept for this ServerModule.
       Since this is a set, you can choose one supported format or all supported formats. }
    property DataFormats:TRtcDataFormatSupport read FDataFormats write FDataFormats default [fmt_RTC];

    { Set this property to a value other than 0 if you want to enable automatic
      Encryption for clients which have their EncryptionKey option activated.
      EncryptionKey value defines the length on the encryption key, in bytes.
      One byte represents encryption strength of 8 bits. To have 256-bit encryption,
      set EncryptionKey=32. @html(<br><br>)

      The final encryption key is combined from a key received by the client
      and a key generated by this ServerModule. When EncryptionKey is >0 by the
      ClientModule doing the call AND by this ServerModule, Encryption handshake will
      be done automatically by those two components, so that the user only has to set
      the values and use the components as if there is no encryption.

      If ServerModule's EncryptionKey property is 0 (zero), server will not allow data to be
      encrypted and all communication with all clients will flow without encryption.
      Clients which have ForceEncryption set to True, will not work if the server
      doesn't want to support encryption. }
    property EncryptionKey:integer read FAutoEncrypt write SetAutoEncrypt default 0;

    { If you need a 100% secure connection, define a Secure Key string
      (combination of letters, numbers and special characters) for each
      ServerModule/ClientModule pair, additionally to the EncryptionKey value.
      ClientModule will be able to communicate with the ServerModule ONLY if
      they both use the same SecureKey. Default value for the SecureKey is
      an empty string (means: no secure key). @html(<br><br>)

      SecureKey will be used in the encryption initialisation handshake,
      to decrypt the first key combination received by the ClientModule.
      Since all other data packages are already sent using some kind of encryption,
      by defining a SecureKey, you encrypt the only key part which would have
      been sent out without special encryption. }
    property SecureKey:string read FSecureKey write FSecureKey;

    { Setting this property to TRUE will tell the ServerModule to work with
      Clients ONLY if they requested to use encryption. If AutoEncryptKey is > 0 and
      Client doesn't request encryption, function calls will not be processed
      and any request coming from the client will be rejected, until
      client requests and initializes encryption. }
    property ForceEncryption:boolean read FForceEncrypt write SetForceEncrypt default False;

    { Using this property, you define how long a session will live (in seconds)
      when there are no requests from this client and the session was
      created by a call from ClientModule that has its AutoSessions property enabled.
      The higher this value, the longer a session will stay valid when there
      are no requests coming from the client for which the session was created.
      This value will be used only after the Client has sent a valid request
      which produces a valid response from the server. Before that, a default
      Session Live time of @Link(RTC_SESSION_TIMEOUT) seconds will be used. @html(<br><br>)

      Session Live counter is reset each time a new request is received from the same client,
      so that this parameter only removes sessions which are inactive longer than
      AutoSessionsLive seconds. To keep your server from nasty clients creating tons of
      sessions and leaving them inactive, keep this property under 600 seconds,
      even if you want your session to stay alive for a long time. You do not have to
      overexagurate this value, since every session consumes memory and client sessions which are not
      needed will ONLY THEN be removed from memory when this AutoSessionsLive timeout expires. }
    property AutoSessionsLive:integer read FAutoSessionsLive write FAutoSessionsLive default 0;

    { Set this property to TRUE if you want ClientModule's to be able to
      reqest a new session automatically by using the NEWID parameter.
      Session handling is built into the ClientModule and uses Request.Params to
      send the Session.ID to the server and Response.Cookie['ID'] to receive a
      new session ID from the server and initialize the session object. @html(<br><br>)

      Since session ID's are communicated automaticaly by the ClientModule and
      ServerModule components, all TRtcFunction and TRtcResult components used by
      this ClientModule will have direct access to the session object.
      When AutoSessions is set to true, Client's can automaticaly request a new
      session is no session exists or when a session expires. @html(<br><br>)

      When AutoSessions is FALSE, you have to request a new session by calling
      a remote server function to generate a new session and return the session ID. }
    property AutoSessions:boolean read FAutoSessions write SetAutoSessions default false;

    { When AutoSessions are used, you can define what client data you want to use to lock the
      Sessions to this client and deny access to session data from other clients. }
    property AutoSessionsLock:TRtcSessionLockType read FAutoSessionsLock write SetAutoSessionsLock default sesFwdLock;

    { If ModuleHost is specified, then Request.Host will be compared to the ModuleHost
      property to decide if this request should be processed by this ServerModule. @html(<br>)
      If your DataServer has to serve more different hosts, while your ServerModule
      is not supposed to react to requests from all those hosts, you can assign the
      host name to which this ServerModule belongs to. If ModuleHost is left blank,
      then this ServerModule will respond to any request asking for this servermodule's
      ModuleFileName, regardless of the HOST header. @html(<br><br>)

      To process all requests for a domain and all of its sub-domains, enter domain name ONLY
      (example: "realthinclient.com" for "realthinclient.com" and any sub-domain like
      "www.realthinclient.com", "mymod.myapp.realthinclient.com", etc). @html(<br>)
      To limit the requests to a sub-domain and its sub-sub-domains, enter the name
      of the highest sub-domain (example: "myapp.realthinclient.com" for
      "myapp.realthinclient.com" and any of its sub-domains like
      "mymod.myapp.realthinclient.com"). @html(<br>)
      To process ONLY requests pointed exactly to ONE HOST, add "." in front of your
      host name (example: ".realthinclient.com" will ONLY react to requests with
      "realthinclient.com" in their HOST header). }
    property ModuleHost:string read GetModuleHost write SetModuleHost;
    { This property will be compared to Request.FileName to decide if the
      request we just received was pointed to this ServerModule. Any request asking
      for this FileName will be processed by this ServerModule component.
      Since parameters are passed to the server module through request's Content
      body (rather than headers), we do not need to check the request for anything
      else than it's FileName to know if the request is directed to this module. }
    property ModuleFileName:string read GetModuleFileName write SetModuleFileName;
    { Set this property to tell the RtcServerModule to use this TRtcFunctionGroup
      component to execute all functions received as a request from clients. }
    property FunctionGroup:TRtcFunctionGroup read GetFunctionGroup write SetFunctionGroup;

    { Event to be triggered after a new Session was opened. }
    property OnSessionOpen:TRtcNotifyEvent read FOnSessionOpen write FOnSessionOpen;
    { Event to be triggered before an existing Session was to be closed. }
    property OnSessionClose:TRtcNotifyEvent read FOnSessionClose write FOnSessionClose;
    { Event to be triggered when the Server starts listening on the connection.
      You can use this event for component initialization. }
    property OnListenStart:TRtcNotifyEvent read FOnListenStart write FOnListenStart;
    { Event to be triggered when the Server stops listening on the connection.
      You can use this event for component deinitialization. }
    property OnListenStop:TRtcNotifyEvent read FOnListenStop write FOnListenStop;
    { Event to be triggered when a child DataProvider component accepts the Request.
      You can use this event for request initialization. For example,
      you could create a DataTunel and assign it to Tunel, to have reuqest data tunneled. }
    property OnRequestAccepted:TRtcNotifyEvent read FOnRequestAccepted write FOnRequestAccepted;
    { Event to be triggered after the response was sent out (Response.Done) }
    property OnResponseDone:TRtcNotifyEvent read FOnResponseDone write FOnResponseDone;
    { Event to be triggered when connection gets lost after a request was accepted.
      You can use this event for component deinitialization. }
    property OnDisconnect:TRtcNotifyEvent read FOnDisconnect write FOnDisconnect;
    end;

{ Post a function call to "Event" using "Param" parameters, delayed for "msDelay" miliseconds.
  If you need to make changes to parameters, do it BEFORE calling PostDelayedCall.
  This procedure ONLY works if  called from a function which was called by TRtcServerModule. }
procedure PostDelayedCall(msDelay:integer; Param:TRtcFunctionInfo; Event:TRtcFunctionCallEvent); overload;

{ Prepare a function call to "Event" using "Param" paremeters, which should be delayed for "msDelay" miliseconds.
  Use "PostDelayedCall" with the object returned from PrepareDelayedCall (TRtcDelayedCall) to post this call.
  You can also use the Result (TRtcDelayedCall) to execute the delayed call sooner (from any thread) by calling "TRtcDelayedCall.WakeUp".
  You can NOT CANCEL THE CALL after you have Posted it with PostDelayedCall.
  If connection should get lost while a Delayed Call is waiting, delayed call will be canceled automaticaly.
  If you need to make any changes to the parameters passed to the delayed call,
  you have to do it BEFORE using PrepareDelayedCall, because PrepareDelayedCall creates a copy of all parameters
  and any change to the original Params will not be reflected in that copy later. }
function PrepareDelayedCall(msDelay:integer; Param:TRtcFunctionInfo; Event:TRtcFunctionCallEvent):TRtcDelayedCall;

{ Post delayed call which was prepared using PrepareDelayedCall.
  You can use the Result (TRtcDelayedCall) to execute the delayed call sooner (from any thread) by using the "TRtcDelayedCall.WakeUp" method.
  You can NOT CANCEL THE CALL after you have Posted it by using PortDelayedCall, you can only Wake it up sooner.
  If connection should get lost while a Delayed Call is waiting, delayed call will be canceled automaticaly. }
procedure PostDelayedCall(cb:TRtcDelayedCall); overload;

{ If you prepared a delayed call, but do not want to Post it anymore,
  use this procedure to cancel it before calling PostDelayedCall. @html(<br>)
  DO NOT CALL THIS PROCEDURE AFTER YOU HAVE POSTED THE CALL!!!!
  You can NOT CANCEL THE CALL after you have Posted it (with PostDelayedCall).
  If connection should get lost while a Delayed Call is waiting, delayed call will be canceled automaticaly. }
procedure CancelDelayedCall(cb:TRtcDelayedCall);

implementation

{ Prepare a function call to "Event" using "Param" paremeters, which should be delayed for "msDelay" miliseconds.
  Use "PostDelayedCall" to post this delayed call, after you've stored the Result returned by this function.
  You can use the Result (TRtcDelayedCall) to execute the delayed call sooner (from any thread) by using the "TRtcDelayedCall.Call" method. }
function PrepareDelayedCall(msDelay:integer; Param:TRtcFunctionInfo; Event:TRtcFunctionCallEvent):TRtcDelayedCall;
  begin
  Result:=TRtcDelayedCall.Create;
  Result.msDelay:=msDelay;
  Result.Param:=TRtcFunctionInfo(Param.copyOf);
  Result.CallEvent:=Event;
  end;

{ Post delayed call which was prepared using PrepareDelayedCall. }
procedure PostDelayedCall(cb:TRtcDelayedCall); overload;
  var
    e:EDelayedCall;
  begin
  e:=EDelayedCall.Create('');
  e.call:=cb;
  raise e;
  end;

procedure CancelDelayedCall(cb:TRtcDelayedCall);
  begin
  cb.Cancel;
  end;

procedure PostDelayedCall(msDelay:integer; Param:TRtcFunctionInfo; Event:TRtcFunctionCallEvent);
  var
    e:EDelayedCall;
  begin
  e:=EDelayedCall.Create('');
  e.call:=PrepareDelayedCall(msDelay,Param,Event);
  raise e;
  end;

{ TRtcServerModule }

constructor TRtcServerModule.Create(AOwner: TComponent);
  begin
  inherited Create(AOwner);
  FDataFormats:=[fmt_RTC];
  FAutoSessionsLock:=sesFwdLock;
  FFunctions:=nil;
  FModuleFileName:='';
  FModuleHost:='';
  end;

destructor TRtcServerModule.Destroy;
  begin
  FFunctions:=nil;
  FModuleFileName:='';
  FModuleHost:='';
  inherited;
  end;

procedure TRtcServerModule.Call_CheckRequest(Sender: TRtcConnection);
  begin
  with TRtcDataServer(Sender) do
    begin
    SetActiveLink(self);
    if Request.FileName=FModuleFileName then
      begin
      if FModuleHost<>'' then
        begin
        if copy(FModuleHost,1,1)<>'.' then // accepting domain with any sub-domain
          begin
          if (UpperCase(Request.Host)=FModuleHost) then // host = domain name
            Accept
          else if ( (length(Request.Host)>length(FModuleHost)) and // could be sub-domain
                    (Copy(Request.Host,length(Request.Host)-length(FModuleHost),1)='.') and // has '.' in the right place
                    ( UpperCase(Copy(Request.Host,length(Request.Host)-length(FModuleHost)+1,length(FModuleHost)))
                      = FModuleHost) ) then // is sub-domain
            Accept;
          end
        else if UpperCase(Request.Host)=Copy(FModuleHost,2,length(FModuleHost)-1) then
          Accept; // accepting a specific sub-domain only
        end
      else // Accept the request. It has our ModuleFileName as Request.FileName, we accept all hosts
        Accept;
      end;
    end;
  end;

procedure TRtcServerModule.Call_ListenStart(Sender: TRtcConnection);
  begin
  if assigned(FOnListenStart) then
    FOnListenStart(Sender);
  end;

procedure TRtcServerModule.Call_ListenStop(Sender: TRtcConnection);
  begin
  if assigned(FOnListenStop) then
    FOnListenStop(Sender);
  end;

procedure TRtcServerModule.Call_SessionClose(Sender: TRtcConnection);
  begin
  if assigned(FOnSessionClose) then
    FOnSessionClose(Sender);
  end;

procedure TRtcServerModule.Call_SessionOpen(Sender: TRtcConnection);
  begin
  if assigned(FOnSessionOpen) then
    FOnSessionOpen(Sender);
  end;

procedure TRtcServerModule.Call_RequestAccepted(Sender: TRtcConnection);
  begin
  try