Jump to content

pssDP

Members
  • Content Count

    10
  • Joined

  • Last visited

Posts posted by pssDP


  1. Found it !!

    Fist, I compiled myself IdCustomHTTPServer module source code, to not mess my installations, here is how:

    1.) Copied IdCustomHTTPServer.pas, IdHTTPServer.pas, IDCompilerDefines.inc to the folder where is the source code of my project.

    2.) Renamed those files in the original location C:\Program Files (x86)\Embarcadero\Studio\15.0\source\Indy10\Protocols

    3.) Renamed IdCustomHTTPServer.dcu in the original location C:\Program Files (x86)\Embarcadero\Studio\15.0\lib\win32\release

    4.) Added log lines to IdCustomHTTPServer.pas file added to my project, as I explained before

    The affected part is in the CreateSession procedure of IdCustomHTTPServer

    function TIdCustomHTTPServer.CreateSession(AContext: TIdContext; HTTPResponse: TIdHTTPResponseInfo;
      HTTPRequest: TIdHTTPRequestInfo): TIdHTTPSession;
    var
      LCookie: TIdCookie;
      // under ARC, convert a weak reference to a strong reference before working with it
      LSessionList: TIdHTTPCustomSessionList;
    begin
      Result := nil;
    GNDebugScan('Begin CreateSession, SessState: ' + BoolToStr(SessionState) + ', SessList: ' + BoolToStr(Assigned(FSessionList)));
     if SessionState then begin
        LSessionList := FSessionList;
        if Assigned(LSessionList) then begin
          DoOnCreateSession(AContext, Result);
    GNDebugScan('After DoOnCreateSession, Result: ' + BoolToStr(Result <> nil));
          if not Assigned(Result) then begin
            Result := LSessionList.CreateUniqueSession(HTTPRequest.RemoteIP);
          end else begin
            LSessionList.Add(Result);
          end;
    GNDebugScan('CreateSession, after CreateUnique: ' + BoolToStr(Result <> nil));
          LCookie := HTTPResponse.Cookies.Add;
          LCookie.CookieName := GSessionIDCookie;
          LCookie.Value := Result.SessionID;
          LCookie.Path := '/';    {Do not Localize}
    
          // By default the cookie will be valid until the user has closed his browser window.
          // MaxAge := SessionTimeOut div 1000;
          HTTPResponse.FSession := Result;
          HTTPRequest.FSession := Result;
        end;
      end;
    GNDebugScan('End CreateSession, SessState: ' + BoolToStr(SessionState) + ', Result: ' + BoolToStr(Result <> nil));
    end;

    With that inserted, I saw that the session was not correctly inserted in the LSessionList because of this in my CreateSession event:

    procedure TAmWebAgeSvc.HTTPServerCreateSession(ASender: TIdContext; var VHTTPSession: TIdHTTPSession);
    begin
      GNDebugScan('CreateSession: ' + VHTTPSession.Content.CommaText);
    end;

    That is, the fact that I used VHTTPSession.Content.CommaText as a debug messed up this var variable.

    Once I deleted this reference, the program now runs as expected.

    Now, I will restore all the original files to their original location

    It goes without saying that I must deeply thank Remy for the help provided.

     


  2. In my first post of this thread you can see what TIdLogFile gives me, and, if you remember I told about that there is no date and time in this log, even if I included this code:

      Intercept := TIdServerInterceptLogFile.Create(nil);
      Intercept.Filename := 'C:\TMP\DBGLOG.TXT';
      Intercept.LogTime := True;
      HTTPServer.Intercept := Intercept;

     

    40 minutes ago, Remy Lebeau said:

    There is no possible way that HeadersCanContinue() and CreatePostStream() would not be called for every request.  So I have to assume that the changes you made to Indy's source code did not take effect, ie you did not recompile Indy, and then recompile your app with the updated library.  If that is not the case, then something else is going on that I can't see.

    HeadersAvailable, CreatePostStream and ParseAuthentication events are fired, and nothing more.

    In HeadersAvailable event I have VContinueProcessing and HTTPServer.SessionState both true.

    What I did was to insert temporally log lines only and nothing more, in the source code of IdCustomHTTPServer module, and compile this module only, not the entire Indy, to avoid messing my production environment, but I think that it is not possible, or at least, I do not know how to do.

    46 minutes ago, Remy Lebeau said:

    Obviously, OnCommandOther would not be called for a GET request, OnCommandGet would be called instead.

    I mean that both OnCommandOther and OnCommandGet are not fired.

     

    47 minutes ago, Remy Lebeau said:

    At this point, your debugging efforts are not really helping.  And I don't have a working environment that I can test with.  So, we are at a stalemate.  Can you, at least, provide a complete log or Wireshark capture of the entire HTTP conservsation that is not working for you?  Also, are you using plain HTTP or secure HTTPS?

    I am using HTTPS, I will try to get a Wireshark capture and post it here.

     

     


  3. To go further, I have added log lines in several places of IdCustomHTTPServer module, and changed the writing of the log with that of IdServerInterceptLogFile, as follows:

    Procedure GNDebugScan(sMsg: String);
    var
      FFileStream: TFileStream;
    
    begin
      FFileStream := TIdAppendFileStream.Create('C:\TMP\DBGLOG.TXT');
      WriteStringToStream(FFileStream, sMsg);
      FreeAndNil(FFileStream);
    end;

    Some top most place is here:

      function HeadersCanContinue: Boolean;
      var
        LResponseNo: Integer;
        LResponseText, LContentText, S: String;
      begin
    GNDebugScan('DoExecute inicio HeadersCanContinue');
    
        // let the user decide if the request headers are acceptable
        Result := DoHeadersAvailable(AContext, LRequestInfo.URI, LRequestInfo.RawHeaders);

    And also here:

      function PreparePostStream: Boolean;
      var
        I, Size: Integer;
        S: String;
        LIOHandler: TIdIOHandler;
      begin
        Result := False;
        LIOHandler := AContext.Connection.IOHandler;
    
    GNDebugScan('DoExecute inicio PreparePostStream:' + BoolToStr(SessionState));
    
        // RLebeau 1/6/2009: don't create the PostStream unless there is
        // actually something to read. This should make it easier for the
        // request handler to know when to use the PostStream and when to
        // use the (Unparsed)Params instead...
    
        if (LRequestInfo.TransferEncoding <> '') and
          (not TextIsSame(LRequestInfo.TransferEncoding, 'identity')) then {do not localize}
        begin
          if IndyPos('chunked', LowerCase(LRequestInfo.TransferEncoding)) = 0 then begin {do not localize}

    But I do not see those logs writen, even the log file is not created.

    Is there any limitation on doing it.

    Also I want to point that I was telling before about that the GET messages are processed is not correct. For those messages I can only see the HeadersAvailable log line and nothing more, so OnCommandOther is not triggered for those GETs.


  4. With respect the extra "xxxx" those are header params app related, not for the session control:

    12/05/2021 17:52:01 HeadersAvailable: "Host: agenda.xxxxxx.com","User-Agent: xxxxxx curl/7.66.0 PHP/7.4.6","Content-Type: application/json","Accept: application/json","Authorization: ApiKey RGxxxxxxxpYxxxxxxxg0U04k","X-Nexxx-ID: VQIDxxxxxVGwIBxxxxxxCUw==","X-Nexxx-Transaction: PxRTWFxxxxxxVlkABgJTBQYxxxxxxxVU4aBgEJAgMxxxxxxdUBENKQQsFxxxxxxxs=","Content-Length: 1576"

     

    All logs presented here are from the same tcp connection. And I do not use KeepAlive := True anywhere, so i think that in this case it is False by default.
    Now I deleted the previous code in ParseAuthentication according to your comments.
    With respect to the 28 seconds later HeadersAvalable log line it is because I receive a GET ping messages every 10 minutes, to check if my server is alive, and in the captured log happenned in the middle. I receive the OnCommand... events for those GETs, and I simply respond with:

    AResponseInfo.ResponseNo := 200;

    Referring SessionState, I have the following code in the initialization process:

         HTTPServer.AutoStartSession := True;    
         HTTPServer.SessionState := True;
         HTTPServer.Active := True;
         Started := True;

    According to your comments, I added a log line for InvalidSession to check for this event too:

     

    Here is the code used in all implied events:

    procedure TAmWebAgeSvc.HTTPServerCreateSession(ASender: TIdContext; var VHTTPSession: TIdHTTPSession);
    begin
      WriteDbgLog('CreateSession: ' + VHTTPSession.Content.CommaText);
    end;
    
    procedure TAmWebAgeSvc.HTTPServerHeadersAvailable(AContext: TIdContext; const AUri: string; AHeaders: TIdHeaderList; var VContinueProcessing: Boolean);
    begin
      WriteDbgLog('HeadersAvailable: ' + AHeaders.CommaText);
    end;
    
    
    procedure TAmWebAgeSvc.HTTPServerCreatePostStream(AContext: TIdContext; AHeaders: TIdHeaderList; var VPostStream: TStream);
    begin
      WriteDbgLog('CreatePostStream: ' + AHeaders.CommaText);
    end;
    
    
    procedure TAmWebAgeSvc.HTTPServerParseAuthentication(AContext: TIdContext; const AAuthType, AAuthData: string; var VUsername, VPassword: string; var VHandled: Boolean);
    begin
      WriteDbgLog('ParseAuthentication: Type: ' + AAuthType + ', Data: ' + AAuthData);
    end;
    
    procedure TAmWebAgeSvc.HTTPServerInvalidSession(AContext: TIdContext; ARequestInfo: TIdHTTPRequestInfo; AResponseInfo: TIdHTTPResponseInfo; var VContinueProcessing: Boolean; const AInvalidSessionID: string);
    begin
     WriteDbgLog('InvalidSession: ' + AInvalidSessionID);
    end;
    
    Procedure WriteDbgLog(sMsg: String);
    var
      sTx: AnsiString;
      sFle: String;
      tsDebugLog: TFileStream;
      fs: TFormatSettings;
    
    begin
      Try
        Try
          sFle := gCfg.sLanDir + '\DBGWEBAG.TXT';
          if FileExists(sFle) = False then
          begin
            // El fichero no existe
            tsDebugLog := TFileStream.Create(sFle, fmCreate or fmShareDenyNone);
            tsDebugLog.Seek(0, soFromEnd);
          end
          else
          begin
            // El fichero ya existe
            tsDebugLog := TFileStream.Create(sFle, fmOpenReadWrite or fmShareDenyNone);
            tsDebugLog.Seek(0, soFromEnd);
          end;
    
          // Grabar el texto al fichero
          fs := TFormatSettings.Create;
          sTx := AnsiString(DateTimeToStr(Now, fs) + ' ' + sMsg + #13#10);
          tsDebugLog.Write(sTx[1], Length(sTx));
    
        Except
          on E: Exception do
        end;
    
      Finally
        // Cerrar
        FreeAndNil(tsDebugLog);
      End;
    end;

     


  5. With respect to the extra ">" this was a typo reducing the log.

    I added date and time to de log

    So, I logged the events, and this is what I get in this same order

     

    12/05/2021 17:52:01 HeadersAvailable: "Host: agenda.xxxxxxxxxxx.com","User-Agent: xxxxxxxxxxx curl/7.66.0 PHP/7.4.6","Content-Type: application/json","Accept: application/json","Authorization: ApiKey xxxxxxxxxxxxxxxxxxxxx", "xxxxxxxxxxxxxxxxxxxx","Content-Length: 1576"

     

    12/05/2021 17:52:01 CreatePostStream: "Host: agenda.xxxxxx.com","User-Agent: xxxxxxx curl/7.66.0 PHP/7.4.6","Content-Type: application/json","Accept: application/json","Authorization: ApiKey xxxxxxxxxxxxxxxxxxxxxxxxx","xxxxxxxxxxxxx","Content-Length: 1576"

     

    12/05/2021 17:52:01 ParseAuthentication: Type: ApiKey, Data: xxxxxxxxxxxxxxxxxxx

     

    12/05/2021 17:52:29 HeadersAvailable: "Host: agenda.xxxxxxxxxxxxxx.com","User-Agent: xxxxxxx curl/7.66.0 PHP/7.4.6","xxxxxxxxxxxxxxxx"

     

    In all implied events there is only a line of code to write to the log file without any other code.

    In ParseAuthentication, besides logging i added the following code to try to avoid the login process by the  moment, but I think that is the reason that the OnCreateSession and subsequent CommandGet are not triggered:

     

      vUserName := 'SHERLOCK';
      VPassword := 'HOLMES';
      VHandled := True;

     


  6. Thanks for your response.

    I see that in the log file there are the entire 1523 bytes of the json response, but here I abbreviated it with dots.

    In the connection and disconnection lines of the log there is not the date and time, so I can not check if all succeds at the same second or later.

    So in my humble opinion, the disconnection is correct.

     

     


  7. Using Delphi XE7 vith Indy version 10.6.1

    After the last modification for adding a new functionañity to my TiDHTTPServer web service, I have a strange issue.

    From an external web service, I need to receive json POST and GET notification messages

    GET notifications are received correctly, but POST notifications does not arrive to CommandGet or CommandOther.

    At the beginnig of those functions I have the following code to know if those notifications really arrive:

        sTx := 'CommandGet Request from ' + ARequestInfo.RemoteIP  + ': ' + ARequestInfo.Command + ': ' + ARequestInfo.Document;

    After installing TIdLogFile to monitor traffic, I can get the log for the incoming POST notifications, but nothing arrives to CommandGet o CommandOther-

    This is the related log:

     

    128.129.130.131:2211 Stat Connected.
    128.129.130.131:2211 Recv 11/05/2021 16:59:01: POST /dpnotify HTTP/1.1<EOL>Host: agenda.sxxxxxx.com<EOL>User-Agent: xxxxxxxxxxxxxxxx curl/7.66.0 PHP/7.4.6<EOL>Content-Type: application/json<EOL>Accept: application/json<EOL>Authorization: ApiKey xxxxxxxxxxxxxxxxxxxxxxxxxxxx<EOL>>Content-Length: 1523<EOL><EOL>{"name":"address","data":.............
    128.129.130.131:2211 Stat Disconnected.
    0.0.0.0:0 Stat Disconnected.

     

    How can I solve where is the problem.


  8. There is no .HttpClientComponent in the System XE7 Library, nor I can find any substitute that can help for that matter.

    So,, you are right about using a more recent Delphi version.

    Prepare a Delphi Trial in a VM is a hard and expensive work if finally the solution is to purchase the last Delphi version for commercial development, so first I will try to find another cheaper solution.

    Also I see that Indy has no OAuth2 interface, so this is not a solution also.

     


  9. While trying to get the token from an OAuth2 authorization web site, I get "error:1409442E:ssl3_read_bytes:tlsv1 alert protocol version"
    I am using the code below using Delphi XE7.
    As stated in some other posts, if using Indy, I can use SSLOptions.SSLVersions := [sslvTLSv1, sslvTLSv1_1, sslvTLSv1_2] to try to solve the problem, but this is not the case because I am using the REST Client Library, and I can not find any equivalent.
    In another post here suggests to use TRESTCLient.SecurityProtocols, but I can not see this property in my XE7.
    The OpenSSL libraries are version 1.0.2q.
    Any ideas on how to solve this problem ?

     


      // OAuth
      OAuth2Authenticator1.ClientId := 'xxxxxwssks8gc4xxxxxx';
      OAuth2Authenticator1.ClientSecret := 'zzzzzzz9lb604zzzzz';
      OAuth2Authenticator1.ResponseType := TOAuth2ResponseType.rtCODE;
      OAuth2Authenticator1.TokenType := TOAuth2TokenType.ttBEARER;

      // Client
      RestClient1.Accept := 'application/json, text/plain; q=0.9, text/html;q=0.8,';
      RestClient1.AcceptCharset := 'UTF-8, *;q=0.8';
      RestClient1.AcceptEncoding := 'identity';
      RestClient1.ContentType := 'application/x-www-form-urlencoded';
      RestClient1.Authenticator := OAuth2Authenticator1;
      RestClient1.BaseURL := 'https://www.myweb.es/token';
      RestClient1.RaiseExceptionOn500 := False;
      RestClient1.Params.Clear;
      RestClient1.HandleRedirects := True;

      // Request
      RestRequest1.Client := RestClient1;
      RestRequest1.Method := TRESTRequestMethod.rmPOST;
      RestRequest1.Accept:='application/json';
      RestRequest1.Params.AddItem('grant_type', 'client_credentials', TRESTRequestParameterKind.pkGETorPOST);
      RestRequest1.Params.AddItem('scope', 'integration', TRESTRequestParameterKind.pkGETorPOST);
      RestRequest1.Response := RestResponse1;
      RestRequest1.SynchronizedEvents := False;

      // Response
      RestResponse1.ContentType := 'application/json';

    Try
      RestRequest1.Execute;
    Except
      on E: Exception do
      begin
        ShowMessage('B01 ERR: ' + E.Message);
      end;

     

×