rtcclimodule.pas

Delphi快速开发Web Server

      Request.Query['ID']:=Session.ID
    else if AutoSessions then
      Request.Query['ID']:='NEW'
    else
      Request.Query['ID']:='';

  if assigned(Link) then
    Link.Call_BeginRequest(Sender)
  else if assigned(Client) then
    Client.CallBeginRequest;

  if not TRtcDataClient(Sender).RequestInserted and
     not TRtcDataClient(Sender).Request.Skipped and
     not TRtcDataClient(Sender).Response.Rejected then
    begin
    if assigned(FOnBeginRequest) then
      if AutoSyncEvents then
        Sender.Sync(FOnBeginRequest)
      else
        FOnBeginRequest(Sender);

    if not TRtcDataClient(Sender).RequestInserted and
       not TRtcDataClient(Sender).Request.Skipped and
       not TRtcDataClient(Sender).Response.Rejected then
      begin
      with TRtcDataClient(Sender) do
        begin
        MyCalls:=TRtcClientModuleCallsArray(Request.Info.Obj['ClientModule.Call$']);
        if not assigned(MyCalls) then
          raise Exception.Create('Internal error! ClientModule objects undefined!');

        if FDataFormat=fmt_RTC then
          crypt:=GetCrypt(Session)
        else
          crypt:=nil;

        compressed:=False;

        {$IFDEF COMPRESS}
        if (FDataFormat=fmt_RTC) and (FCompress<>cNone) then
          begin
          if MyCalls.Count=1 then
            code:=MyCalls.asCode[0]
          else
            begin
            output:=TRtcHugeString.Create;
            try
              for idx:=0 to MyCalls.Count-1 do
                output.Add(MyCalls.asCode[idx]);
              code:= output.Get;
            finally
              output.Free;
              end;
            end;

          if length(code)<RTC_MIN_COMPRESS_SIZE then
            begin
            CryptWrite(crypt, code);
            Write(code);
            end
          else
            begin
            { Using compression,
              need to compress all data now. }
            case FCompress of
              cFast: temp:=ZCompress_Str(code,zcFastest);
              cMax: temp:=ZCompress_Str(code,zcMax);
              else temp:=ZCompress_Str(code,zcDefault);
              end;
            // use compressed version ONLY if smaller than uncompressed
            if length(temp)<length(code)-1 then
              begin
              code:='';
              CryptWrite(crypt, temp);
              Write(temp);

              temp:=#0;
              CryptWrite(crypt, temp);
              Write(temp);
              temp:='';

              compressed:=True;
              end
            else
              begin
              temp:='';
              CryptWrite(crypt, code);
              Write(code);
              code:='';
              end;
            end;
          end
        else
        {$ENDIF}
          begin
          if FDataFormat=fmt_RTC then
            begin
            if not assigned(crypt) then
              begin
              for idx:=0 to MyCalls.Count-1 do
                begin
                code:=MyCalls.asCode[idx];
                Write(code);
                end;
              end
            else
              begin
              for idx:=0 to MyCalls.Count-1 do
                begin
                code:=MyCalls.asCode[idx];
                CryptWrite(crypt, code);
                Write(code);
                end;
              end;
            end
          else
            begin
            for idx:=0 to MyCalls.Count-1 do
              begin
              obj:=MyCalls.asObject[idx];
              if not assigned(obj) then
                raise Exception.Create('XML-RPC Error! Can not make a "NIL" call!')
              else
                code:=obj.toXMLrpcRequest;
              Write(code);
              end;
            end;
          end;

        if (FDataFormat=fmt_RTC) then
          begin
          if assigned(crypt) and assigned(crypt.Write) then
            begin
            { Add random control number at the end of the request,
              so we can check if the response is correctly encrypted. }
            crypt.ControlKey := GenerateControlKey(crypt.ControlCounter);

            if not compressed then
              code:=#13+crypt.ControlKey
            else // #0 was allready added
              code:=crypt.ControlKey; // we just need to add the control number

            CryptWrite(crypt, code);
            Write(code);
            end;
          end;

        code:='';
        end;
      end;
    end;
  end;

procedure TRtcClientModule.Call_DataReceived(Sender: TRtcConnection);
  var
    idx:integer;
    code:string;
    at:integer;
    MyTemp:TRtcValue;
    crypt:TRtcCryptClient;
    c1,c2:string;
    c3:integer;
    MyData,MyResult:TRtcValueObject;
    MyCalls:TRtcClientModuleCallsArray;
  begin
  with TRtcDataClient(Sender) do if Response.Done then
    if AutoSyncEvents and not Sender.inMainThread then
      {$IFDEF FPC}
      Sender.Sync(@Call_DataReceived)
      {$ELSE}
      Sender.Sync(Call_DataReceived)
      {$ENDIF}
    else if Response.StatusCode=410 then // Status 410 = Gone: Session ID invalid, clear local Session info.
      begin
      Call_SessionExpired(Sender);
      end
    else if Response.StatusCode=412 then // Status 412 = Precondition Failed: Encryption required
      begin
      Call_NeedEncryption(Sender);
      end
    else if Response.StatusCode=409 then // Status 409 = Conflict: Wrong Encryption Key
      begin
      Call_WrongEncryption(Sender);
      end
    else if Response.StatusCode<>200 then // Accept only responses with status 200 OK.
      begin
      Call_WrongResponse(Sender);
      end
    else if (EncryptionKey>0) and
            (Request.Query['ACTION']='HELLO') then
      begin
      // Prepare Session
      if (Session.ID='') then
        begin
        if (Response.Cookie['ID']='') then
          begin
          if ForceEncryption then
            begin
            Call_WrongResponse(Sender);
            Exit;
            end
          else
            begin
            NewCrypt(Session);
            crypt:=GetCrypt(Session);
            end;
          end
        else
          begin
          c1:=GetCrypt(Session).ClientHello;
          c2:=GetCrypt(Session).ControlKey;
          c3:=GetCrypt(Session).ControlCounter;
          Session.Open(Response.Cookie['ID']); // Set new Session ID
          NewCrypt(Session);
          crypt:=GetCrypt(Session);
          crypt.ClientHello:=c1;
          crypt.ControlKey:=c2;
          crypt.ControlCounter:=c3;
          end;
        end
      else if (Response.Cookie['ID']<>'') and
              (Session.ID<>Response.Cookie['ID']) then
        begin
        c1:=GetCrypt(Session).ClientHello;
        c2:=GetCrypt(Session).ControlKey;
        c3:=GetCrypt(Session).ControlCounter;
        Session.Open(Response.Cookie['ID']); // Set new Session ID
        NewCrypt(Session);
        crypt:=GetCrypt(Session);
        crypt.ClientHello:=c1;
        crypt.ControlKey:=c2;
        crypt.ControlCounter:=c3;
        end
      else
        crypt:=GetCrypt(Session);

      code:=Read;
      crypt.HaveHello:=True;

      if code='' then // Server does not support encryption
        begin
        if ForceEncryption then
          begin
          Call_NoEncryption(Sender);
          Exit;
          end
        else
          begin
          crypt.Init;
          crypt.HaveHello:=True;
          crypt.HaveStart:=True;
          end;
        end
      else if length(code)<=length(crypt.ControlKey) then // Wrong response from server
        begin
        Call_WrongEncryption(Sender);
        Exit;
        end
      else
        begin
        // Prepare the Encryption object for Reading
        if assigned(crypt.Read) then
          crypt.Read.Free;

        crypt.Read:=TRtcCrypt.Create;
        crypt.Read.Key:=crypt.ClientHello;

        // DeCrypt Server-Hello + Client-Hello
        CryptRead(crypt, code);

        // Check if response ends with sent control key
        if Copy(code, length(code)-length(crypt.ControlKey)+1, length(crypt.ControlKey))<>
           crypt.ControlKey then
          begin
          Call_WrongEncryption(Sender);
          Exit;
          end
        else
          Delete(code, length(code)-length(crypt.ControlKey)+1, length(crypt.ControlKey));

        crypt.ServerHello:=code;

        // Prepare the Encryption object for Writing
        if assigned(crypt.Write) then crypt.Write.Free;
        crypt.Write:=TRtcCrypt.Create;
        crypt.Write.Key:=crypt.ServerHello;
        end;
      end
    else if (EncryptionKey>0) and
            (Request.Query['ACTION']='START') then
      begin
      crypt:=GetCrypt(Session);

      code:=Read;
      crypt.HaveStart:=True;

      if code='' then // Server canceled encryption
        begin
        if ForceEncryption then
          begin
          Call_NoEncryption(Sender);
          Exit;
          end
        else
          begin
          crypt.Init;
          crypt.HaveHello:=True;
          crypt.HaveStart:=True;
          end;
        end
      else if length(code)<=length(crypt.ControlKey) then // Wrong response from server
        begin
        Call_WrongEncryption(Sender);
        Exit;
        end
      else
        begin
        // Set new Reading Key
        crypt.Read.Key:=crypt.ClientKey + crypt.ServerHello;

        // DeCrypt response: Server-Key + Client-Key
        CryptRead(crypt, code);

        // Check if response ends with sent Control Key
        if Copy(code, length(code)-length(crypt.ControlKey)+1, length(crypt.ControlKey))<>
           crypt.ControlKey then
          begin
          Call_WrongEncryption(Sender);
          Exit;
          end
        else
          Delete(code, length(code)-length(crypt.ControlKey)+1, length(crypt.ControlKey));

        crypt.ServerKey:=code;

        // Set new Writing Key
        crypt.Write.Key:=crypt.ServerKey + crypt.ClientHello;
        end;
      end
    else
      begin
      if Request.Query['ID']='NEW' then // we have requested a new session ID
        if Response.Cookie['ID']<>'' then
          Session.Open(Response.Cookie['ID']);

      MyCalls:=TRtcClientModuleCallsArray(Request.Info.Obj['ClientModule.Call$']);
      if not assigned(MyCalls) then
        raise Exception.Create('Internal error! ClientModule objects undefined!');

      code := Read;

      if FDataFormat=fmt_RTC then
        begin
        crypt:=GetCrypt(Session);
        if assigned(crypt) and assigned(crypt.Read) then
          begin
          if code='' then
            begin
            Call_WrongEncryption(Sender);
            Exit;
            end
          else if length(code)<=length(crypt.ControlKey) then // Wrong response from server
            begin
            Call_WrongEncryption(Sender);
            Exit;
            end
          else
            begin
            // Response has to END with our ControlKey
            CryptRead(crypt, code);
            if Copy(code, length(code)-length(crypt.ControlKey)+1, length(crypt.ControlKey))<>
               crypt.ControlKey then
              begin
              Call_WrongEncryption(Sender);
              Exit;
              end
            else
              begin
              {$IFDEF COMPRESS}
              // There is #0 before the Control Key, data is compressed
              if Copy(code,length(code)-length(crypt.ControlKey),1)=#0 then
                begin
                try
                  code:=ZDecompress_Str(code, length(code)-length(crypt.ControlKey)-1);
                except
                  on E:Exception do
                    begin
                    Call_WrongResponse(Sender);
                    Exit;
                    end;
                  end;
                end
              else