[SOLVED] Get body received on TTCPBlockSocket
lazarus / 38-Networking and Web Programming

----------------------------------------------------------------------
tudi_x · 2017-11-27 16:18

hi All,
i am using the Synapse example in Wiki as per the below to capture
POST and GET bodies from HTTP requests.
i am going around in circles but could net get how to capture the HTTP
bodies in order to extract the multipart section with the request
parameters. currently the repeat stops exactly before body (around
line 87). how can i continue in order to stop after body end?
please help.
thank you!

Code: Pascal  [Select][+][-]window.onload = function(){var x1 =
document.getElementById("main_content_section"); if (x1) { var x =
document.getElementsByClassName("geshi");for (var i = 0; i unit
http_listen; {$mode objfpc}{$H+} interface uses  Classes, SysUtils,
blcksock, sockets,  Synautil;   //needs synapse type  TPassMessage =
procedure(AMsg: string) of object;   TLightWeb = class(TThread) 
private    _Port: word;    _PassMessage: TPassMessage;    procedure
AttendConnection(ASocket: TTCPBlockSocket);    procedure
TriggerMessage(AMsg: string);  protected    procedure Execute;
override;  public    constructor Create(APort: word);    destructor
Destroy; override;    property OnPassMessage: TPassMessage read
_PassMessage write _PassMessage;  end; implementation constructor
TLightWeb.Create(APort: word);begin  inherited Create(False);   _Port
:= Aport;end; procedure TLightWeb.Execute;var  ListenerSocket,
ConnectionSocket: TTCPBlockSocket; begin  try    ListenerSocket :=
TTCPBlockSocket.Create;    ConnectionSocket :=
TTCPBlockSocket.Create;     ListenerSocket.CreateSocket;   
ListenerSocket.setLinger(True, 10);    ListenerSocket.bind('0.0.0.0',
IntToStr(_Port));    ListenerSocket.listen;     repeat      if
ListenerSocket.canread(1000) then      begin       
ConnectionSocket.Socket := ListenerSocket.accept;       
WriteLn('Attending Connection. Error code (0=Success): ',
ConnectionSocket.lasterror);       
AttendConnection(ConnectionSocket);       
ConnectionSocket.CloseSocket;      end;    until Terminated;  
finally    FreeAndNil(ListenerSocket);   
FreeAndNil(ConnectionSocket);  end;end; procedure
TLightWeb.AttendConnection(ASocket: TTCPBlockSocket);var  timeout:
integer;  s: string; begin  timeout := 120000;   try    try     
WriteLn('Received headers + document from browser:');      s :=
ASocket.RecvString(timeout);       WriteLn(s);       //read buffer   
 repeat        s := ASocket.RecvString(Timeout);        WriteLn(s);  
    TriggerMessage(s);      until s = '';   //stops at headers. how to
capture all?       // Write the headers back to the client     
ASocket.SendString('HTTP/1.0 200' + CRLF);     
ASocket.SendString('Content-type: Text/Html' + CRLF);     
ASocket.SendString('Content-length: 0' + CRLF);     
ASocket.SendString('Connection: close' + CRLF);     
ASocket.SendString('Date: ' + Rfc822DateTime(now) + CRLF);     
ASocket.SendString('Server: Lazarus Synapse' + CRLF);     
ASocket.SendString('' + CRLF);     except      on E: Exception do    
begin       end;    end;  finally  end;end; procedure
TLightWeb.TriggerMessage(AMsg: string);begin  if
Assigned(_PassMessage) then    _PassMessage(AMsg);end; destructor
TLightWeb.Destroy();begin  inherited Destroy;end; end.

----------------------------------------------------------------------
tudi_x · 2017-11-30 11:41

it looks like the below would actually read also the body and work for
text requests:

Code: Pascal  [Select][+][-]window.onload = function(){var x1 =
document.getElementById("main_content_section"); if (x1) { var x =
document.getElementsByClassName("geshi");for (var i = 0; i unit
http_listen; {$mode objfpc}{$H+}//{$DEFINE Debug} interface uses 
Classes, SysUtils, blcksock, sockets,  strutils,  Synautil;   //needs
synapse type  TPassMessage = procedure(AMsg: string) of object;  
TLightWeb = class(TThread)  private    _Port: word;    _PassMessage:
TPassMessage;    procedure AttendConnection(ASocket:
TTCPBlockSocket);    procedure TriggerMessage(AMsg: string); 
protected    procedure Execute; override;  public    constructor
Create(APort: word);    destructor Destroy; override;    property
OnPassMessage: TPassMessage read _PassMessage write _PassMessage; 
end; implementation constructor TLightWeb.Create(APort: word);begin 
inherited Create(False);   _Port := Aport;end; procedure
TLightWeb.Execute;var  ListenerSocket, ConnectionSocket:
TTCPBlockSocket; begin  try    ListenerSocket :=
TTCPBlockSocket.Create;    ConnectionSocket :=
TTCPBlockSocket.Create;     ListenerSocket.CreateSocket;   
ListenerSocket.setLinger(True, 10);    ListenerSocket.bind('0.0.0.0',
IntToStr(_Port));    ListenerSocket.listen;     repeat      if
ListenerSocket.canread(1000) then      begin       
ConnectionSocket.Socket := ListenerSocket.accept;       
WriteLn('Attending Connection. Error code (0=Success): ',
ConnectionSocket.lasterror);       
AttendConnection(ConnectionSocket);       
ConnectionSocket.CloseSocket;      end;    until Terminated;  
finally    FreeAndNil(ListenerSocket);   
FreeAndNil(ConnectionSocket);  end;end; procedure
TLightWeb.AttendConnection(ASocket: TTCPBlockSocket);var  timeout:
integer;  message: TStringList;  without_body: word;  content: word =
0; begin  timeout := 120000;  message := TStringList.Create;   try   
try      {https://www.w3.org/Protocols/rfc2616/rfc2616-sec4.html}    
{message type}      message.Append(ASocket.RecvString(Timeout));     
{$IF DEFINED(Debug)}      WriteLn(message.Strings[message.Count -
1]);      {$EndIF}       {headers}      repeat       
message.Append(ASocket.RecvString(Timeout));       
WriteLn(message.Strings[message.Count - 1]);         if
AnsiContainsText(message.Strings[message.Count - 1], 'Content-Length')
then        begin          content :=
StrToInt(copy(message.Strings[message.Count - 1], pos(':',
message.Strings[message.Count - 1]) + 1,
Length(message.Strings[message.Count - 1])));        end;      until
message.Strings[message.Count - 1] = '';       {body}      if content
> 0 then      begin        without_body := Length(message.Text);     
 writeln('content: ' + IntToStr(content) + '|' + 'headers: ' +
IntToStr(without_body));        TriggerMessage('content: ' +
IntToStr(content) + '|' + 'headers: ' + IntToStr(without_body));     
  repeat          message.Append(ASocket.RecvString(Timeout));       
  {$IF DEFINED(Debug)}          writeln('all: ' +
IntToStr(length(message.Text)));         
WriteLn(message.Strings[message.Count - 1]);         
writeln(IntToStr(length(message.Text) - without_body - content));    
    {$EndIF}         until length(message.Text) - without_body >=
content;      end;       TriggerMessage(message.Text);     
message.Clear;       // Write the headers back to the client     
ASocket.SendString('HTTP/1.0 200' + CRLF);     
ASocket.SendString('Content-type: Text/Html' + CRLF);     
ASocket.SendString('Content-length: 0' + CRLF);     
ASocket.SendString('Connection: close' + CRLF);     
ASocket.SendString('Date: ' + Rfc822DateTime(now) + CRLF);     
ASocket.SendString('Server: Lazarus Synapse' + CRLF);     
ASocket.SendString('' + CRLF);     except      on E: Exception do    
begin        TriggerMessage(E.Message);      end;    end;  finally   
FreeAndNil(message);  end;end; procedure
TLightWeb.TriggerMessage(AMsg: string);begin  if
Assigned(_PassMessage) then    _PassMessage(AMsg);end; destructor
TLightWeb.Destroy();begin  inherited Destroy;end; end.