Jump to content

pssDP

Members
  • Content Count

    10
  • Joined

  • Last visited

Community Reputation

0 Neutral
  1. pssDP

    TIDHTTPServer not receiving POST

    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. pssDP

    TIDHTTPServer not receiving POST

    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; 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. I mean that both OnCommandOther and OnCommandGet are not fired. I am using HTTPS, I will try to get a Wireshark capture and post it here.
  3. pssDP

    TIDHTTPServer not receiving POST

    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. pssDP

    TIDHTTPServer not receiving POST

    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. pssDP

    TIDHTTPServer not receiving POST

    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. pssDP

    TIDHTTPServer not receiving POST

    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. pssDP

    TIDHTTPServer not receiving POST

    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. Finally, I have followed the advice of KodeZwerg, installing Delphi Community Edition in a VM, and it worked. So this tells me that something is wrong in the Rest Client Library of Delphi XE7. Thanks to all for your help.
  9. 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.
  10. 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;
×