[SOLVED] Get body received on TTCPBlockSocket

[tudi_x]

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][+][-]

1. unit http_listen;
2.  
3. {$mode objfpc}{$H+}
4.  
5. interface
6.  
7. uses
8.   Classes, SysUtils, blcksock, sockets,
9.   Synautil;   //needs synapse
10.  
11. type
12.   TPassMessage = procedure(AMsg: string) of object;
13.  
14.   TLightWeb = class(TThread)
15.   private
16.     _Port: word;
17.     _PassMessage: TPassMessage;
18.     procedure AttendConnection(ASocket: TTCPBlockSocket);
19.     procedure TriggerMessage(AMsg: string);
20.   protected
21.     procedure Execute; override;
22.   public
23.     constructor Create(APort: word);
24.     destructor Destroy; override;
25.     property OnPassMessage: TPassMessage read _PassMessage write _PassMessage;
26.   end;
27.  
28. implementation
29.  
30. constructor TLightWeb.Create(APort: word);
31. begin
32.   inherited Create(False);
33.  
34.   _Port := Aport;
35. end;
36.  
37. procedure TLightWeb.Execute;
38. var
39.   ListenerSocket, ConnectionSocket: TTCPBlockSocket;
40.  
41. begin
42.   try
43.     ListenerSocket := TTCPBlockSocket.Create;
44.     ConnectionSocket := TTCPBlockSocket.Create;
45.  
46.     ListenerSocket.CreateSocket;
47.     ListenerSocket.setLinger(True, 10);
48.     ListenerSocket.bind('0.0.0.0', IntToStr(_Port));
49.     ListenerSocket.listen;
50.  
51.     repeat
52.       if ListenerSocket.canread(1000) then
53.       begin
54.         ConnectionSocket.Socket := ListenerSocket.accept;
55.         WriteLn('Attending Connection. Error code (0=Success): ', ConnectionSocket.lasterror);
56.         AttendConnection(ConnectionSocket);
57.         ConnectionSocket.CloseSocket;
58.       end;
59.     until Terminated;
60.  
61.   finally
62.     FreeAndNil(ListenerSocket);
63.     FreeAndNil(ConnectionSocket);
64.   end;
65. end;
66.  
67. procedure TLightWeb.AttendConnection(ASocket: TTCPBlockSocket);
68. var
69.   timeout: integer;
70.   s: string;
71.  
72. begin
73.   timeout := 120000;
74.  
75.   try
76.     try
77.       WriteLn('Received headers + document from browser:');
78.       s := ASocket.RecvString(timeout);
79.  
80.       WriteLn(s);
81.  
82.       //read buffer
83.       repeat
84.         s := ASocket.RecvString(Timeout);
85.         WriteLn(s);
86.         TriggerMessage(s);
87.       until s = '';   //stops at headers. how to capture all?
88.  
89.       // Write the headers back to the client
90.       ASocket.SendString('HTTP/1.0 200' + CRLF);
91.       ASocket.SendString('Content-type: Text/Html' + CRLF);
92.       ASocket.SendString('Content-length: 0' + CRLF);
93.       ASocket.SendString('Connection: close' + CRLF);
94.       ASocket.SendString('Date: ' + Rfc822DateTime(now) + CRLF);
95.       ASocket.SendString('Server: Lazarus Synapse' + CRLF);
96.       ASocket.SendString('' + CRLF);
97.  
98.     except
99.       on E: Exception do
100.       begin
101.  
102.       end;
103.     end;
104.   finally
105.   end;
106. end;
107.  
108. procedure TLightWeb.TriggerMessage(AMsg: string);
109. begin
110.   if Assigned(_PassMessage) then
111.     _PassMessage(AMsg);
112. end;
113.  
114. destructor TLightWeb.Destroy();
115. begin
116.   inherited Destroy;
117. end;
118.  
119. end.

[tudi_x]

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

Code: Pascal  [Select][+][-]

1. unit http_listen;
2.  
3. {$mode objfpc}{$H+}
4. //{$DEFINE Debug}
5.  
6. interface
7.  
8. uses
9.   Classes, SysUtils, blcksock, sockets,
10.   strutils,
11.   Synautil;   //needs synapse
12.  
13. type
14.   TPassMessage = procedure(AMsg: string) of object;
15.  
16.   TLightWeb = class(TThread)
17.   private
18.     _Port: word;
19.     _PassMessage: TPassMessage;
20.     procedure AttendConnection(ASocket: TTCPBlockSocket);
21.     procedure TriggerMessage(AMsg: string);
22.   protected
23.     procedure Execute; override;
24.   public
25.     constructor Create(APort: word);
26.     destructor Destroy; override;
27.     property OnPassMessage: TPassMessage read _PassMessage write _PassMessage;
28.   end;
29.  
30. implementation
31.  
32. constructor TLightWeb.Create(APort: word);
33. begin
34.   inherited Create(False);
35.  
36.   _Port := Aport;
37. end;
38.  
39. procedure TLightWeb.Execute;
40. var
41.   ListenerSocket, ConnectionSocket: TTCPBlockSocket;
42.  
43. begin
44.   try
45.     ListenerSocket := TTCPBlockSocket.Create;
46.     ConnectionSocket := TTCPBlockSocket.Create;
47.  
48.     ListenerSocket.CreateSocket;
49.     ListenerSocket.setLinger(True, 10);
50.     ListenerSocket.bind('0.0.0.0', IntToStr(_Port));
51.     ListenerSocket.listen;
52.  
53.     repeat
54.       if ListenerSocket.canread(1000) then
55.       begin
56.         ConnectionSocket.Socket := ListenerSocket.accept;
57.         WriteLn('Attending Connection. Error code (0=Success): ', ConnectionSocket.lasterror);
58.         AttendConnection(ConnectionSocket);
59.         ConnectionSocket.CloseSocket;
60.       end;
61.     until Terminated;
62.  
63.   finally
64.     FreeAndNil(ListenerSocket);
65.     FreeAndNil(ConnectionSocket);
66.   end;
67. end;
68.  
69. procedure TLightWeb.AttendConnection(ASocket: TTCPBlockSocket);
70. var
71.   timeout: integer;
72.   message: TStringList;
73.   without_body: word;
74.   content: word = 0;
75.  
76. begin
77.   timeout := 120000;
78.   message := TStringList.Create;
79.  
80.   try
81.     try
82.       {https://www.w3.org/Protocols/rfc2616/rfc2616-sec4.html}
83.       {message type}
84.       message.Append(ASocket.RecvString(Timeout));
85.       {$IF DEFINED(Debug)}
86.       WriteLn(message.Strings[message.Count - 1]);
87.       {$EndIF}
88.  
89.       {headers}
90.       repeat
91.         message.Append(ASocket.RecvString(Timeout));
92.         WriteLn(message.Strings[message.Count - 1]);
93.  
94.         if AnsiContainsText(message.Strings[message.Count - 1], 'Content-Length') then
95.         begin
96.           content := StrToInt(copy(message.Strings[message.Count - 1], pos(':', message.Strings[message.Count - 1]) + 1, Length(message.Strings[message.Count - 1])));
97.         end;
98.       until message.Strings[message.Count - 1] = '';
99.  
100.       {body}
101.       if content > 0 then
102.       begin
103.         without_body := Length(message.Text);
104.         writeln('content: ' + IntToStr(content) + '|' + 'headers: ' + IntToStr(without_body));
105.         TriggerMessage('content: ' + IntToStr(content) + '|' + 'headers: ' + IntToStr(without_body));
106.  
107.         repeat
108.           message.Append(ASocket.RecvString(Timeout));
109.  
110.           {$IF DEFINED(Debug)}
111.           writeln('all: ' + IntToStr(length(message.Text)));
112.           WriteLn(message.Strings[message.Count - 1]);
113.           writeln(IntToStr(length(message.Text) - without_body - content));
114.           {$EndIF}
115.  
116.         until length(message.Text) - without_body >= content;
117.       end;
118.  
119.       TriggerMessage(message.Text);
120.       message.Clear;
121.  
122.       // Write the headers back to the client
123.       ASocket.SendString('HTTP/1.0 200' + CRLF);
124.       ASocket.SendString('Content-type: Text/Html' + CRLF);
125.       ASocket.SendString('Content-length: 0' + CRLF);
126.       ASocket.SendString('Connection: close' + CRLF);
127.       ASocket.SendString('Date: ' + Rfc822DateTime(now) + CRLF);
128.       ASocket.SendString('Server: Lazarus Synapse' + CRLF);
129.       ASocket.SendString('' + CRLF);
130.  
131.     except
132.       on E: Exception do
133.       begin
134.         TriggerMessage(E.Message);
135.       end;
136.     end;
137.   finally
138.     FreeAndNil(message);
139.   end;
140. end;
141.  
142. procedure TLightWeb.TriggerMessage(AMsg: string);
143. begin
144.   if Assigned(_PassMessage) then
145.     _PassMessage(AMsg);
146. end;
147.  
148. destructor TLightWeb.Destroy();
149. begin
150.   inherited Destroy;
151. end;
152.  
153. end.