Arief Sujatmiko on Blogspot: Creating Simple Web Server with Lazarus

Web server is a program or sub program that provide data to client program not limited to web browser using HTTP or HTTPS (HTTP over SSL) protocol. HTTP is a simple, fast and robust protocol for client-server application. The HTTP protocol works by having the client send a request to the server, then the server processes the request and sends back a response to the client.

Example of HTTP Client's Request:

GET / HTTP/1.1
Host: www.example.com

The first line of a HTTP request consist of a command, a url and the protocol version. Followed by header lines and terminated by empty line. Each header line consist of header name and value separated by colon and one space. After the header data is the content data that contain n bytes where n is the value of Content-Length header.

Example of HTTP Server's Response:

HTTP/1.1 200 OK
Date: Mon, 23 May 2005 22:38:34 GMT
Content-Type: text/html; charset=UTF-8
Content-Length: 155
Last-Modified: Wed, 08 Jan 2003 23:11:55 GMT
Server: Apache/1.3.3.7 (Unix) (Red-Hat/Linux)
ETag: "3f80f-1b6-3e1cb03b"
Accept-Ranges: bytes
Connection: close

<html>
  <head>
    <title>An Example Page</title>
  </head>
  <body>
    <p>Hello World, this is a very simple HTML document.</p>
  </body>
</html>

The first line of a HTTP response consist of protocol version and result code followed by error message. Followed by header lines and terminated by empty line. Each header line consist of header name and value separated by colon and one space. After the header data is the content data that contain n bytes where n is the value of Content-Length header.

Free Pascal, Delphi and Lazarus share the same programming language the Object Pascal with little differentiation. So many Delphi component can be used in Lazarus and vice versa because it only requires minor changes in the source code to support both programming. If you don't want to use visual component you can use operating system API like winsock (Windows Socket) for Windows or unisock (Unix Socket) for Linux. I will use synapse for Free Pascal library in this example.

To help parsing input data I create TStringSplitter :

type
{ TStringSplitter }
TStringSplitter = class(TObject)
private
FLine: String;
FCol: Integer;
procedure SetCol(AValue: Integer);
procedure SetLine(AValue: String);
public
constructor Create;
function Fetch(const ATerminator: String=''): String;
property Line: String read FLine write SetLine;
property Col: Integer read FCol write SetCol;
end;
function PosAfter(const SubText, Text: String; StartAt: Integer): Integer;
var
I, L1, L2: Integer;
begin
Result := -1;
L1 := Length(SubText);
L2 := Length(Text);
if ((L1 > L2) or (StartAt < 1)) then exit;
for I := StartAt to L2-L1+1 do
if (CompareMem(@SubText[1], @Text[I], L1)) then
begin
Result := I;
exit;
end;
end;
procedure TStringSplitter.SetCol(AValue: Integer);
begin
FCol := AValue;
end;
procedure TStringSplitter.SetLine(AValue: String);
begin
FLine := AValue;
FCol := 1;
end;
constructor TStringSplitter.Create;
begin
FLine := '';
FCol := 1;
end;
function TStringSplitter.Fetch(const ATerminator: String): String;
var
I, J: Integer;
begin
Result := '';
I := FCol;
if (I > Length(FLine)) then exit;
if (ATerminator <> '') then
begin
J := PosAfter(ATerminator, FLine, I);
if (J > 0) then
begin
Result := Copy(FLine, I, J-I);
FCol := J + Length(ATerminator);
exit;
end;
end;
Result := Copy(FLine, FCol, MaxInt);
FCol := Length(FLine) + 1;
end;

When the server is started it initialize the socket to listen to the specified port. Then it repeatly check for incoming connection and start HTTP handler worker thread until the server is terminated.

procedure TDaemon1.WorkServerListener(Thread: TWorkerThread);
var
sock: TTCPBlockSocket;
h: TSocket;
begin
try
sock := TTCPBlockSocket.Create;
try
sock.Bind('0.0.0.0',IntToStr(Port));
if (sock.LastError <> 0) then
raise ENetworkError.Create('Cannot bind to port '+IntToStr(Port));
sock.Listen;
if (sock.LastError <> 0) then
raise ENetworkError.Create('Cannot listen to port '+IntToStr(Port));
while (not Thread.Terminated) do
begin
if (sock.CanRead(0)) then
begin
h := sock.Accept;
{$HINTS OFF}
if (h <> INVALID_SOCKET) then
WorkerThreads.AddNew(@WorkRequestHandler,Pointer(h));
{$HINTS ON}
end
else
Sleep(1);
end;
finally
sock.Free; // close and free socket object
end;
except
on E: Exception do
// DebugLog('HTTP Server terminated by error '+E.ClassName+': '+
// E.Message);
end;
end;

The HTTP handler worker thread read HTTP request from incoming connection and send back HTTP Respond.

procedure TDaemon1.WorkRequestHandler(Thread: TWorkerThread);
var
sock: TTCPBlockSocket;
S1: TStringSplitter;
s, cmd, url, http_ver, nm, vl, error_msg, respond_text, respond_data: AnsiString;
I, result_code: Integer;
close_socket, can_read: Boolean;
headers, gets, respond_headers: TStrings;
begin
result_code := 500;
close_socket := True;
sock := TTCPBlockSocket.Create;
S1 := TStringSplitter.Create;
headers := TStringList.Create;
gets := TStringList.Create;
respond_headers := TStringList.Create;
try
{$HINTS OFF}
sock.Socket := TSocket(Thread.Param);
{$HINTS ON}
repeat
can_read := sock.CanRead(0);
if (sock.LastError <> 0) then exit;
if (can_read) then
begin
I := Pos('?',url);
if (I >= 1) then
begin
S1.Line := Copy(url, I+1, MaxInt);
repeat
nm := S1.Fetch('=');
if (nm <> '') then
begin
vl := S1.Fetch('&');
gets.Values[nm] := vl;
end;
until (nm = '');
Delete(url,I,MaxInt);
end;
S1.Line := sock.RecvString(ReadTimeout);
if (sock.LastError <> 0) then exit;
cmd := S1.Fetch(' ');
url := S1.Fetch(' ');
http_ver := S1.Fetch;
if ((cmd = 'GET') or (cmd = 'POST')) then
begin
close_socket := (http_ver = 'HTTP/0.9') or (http_ver = 'HTTP/1.0');
S1.Line := sock.RecvString(ReadTimeout);
if (sock.LastError <> 0) then exit;
while (S1.Line <> '') do
begin
nm := S1.Fetch(': ');
vl := S1.Fetch;
headers.Values[nm] := vl;
S1.Line := sock.RecvString(ReadTimeout);
if (sock.LastError <> 0) then exit;
end;
//
// .. do some processing here
//
respond_data :=
'<head><title>Welcome</title></head><body><h1>Welcome to my Web Server</h1><p>You are in here: '+HttpEncode(url)+'</body>';
respond_headers.Values['Content-Type'] := 'html/text';
respond_headers.Values['Content-Length'] := IntToStr(Length(respond_data));
result_code := 200;
end
else begin
result_code := 501;
close_socket := True;
end;
if((result_code < 200) or (result_code > 499)) then close_socket := True;
case result_code of
200: error_msg := 'OK';
400: error_msg := 'Bad Reqeust';
500: error_msg := 'Internal Server Error';
501: error_msg := 'Not Implemented';
end;
respond_text :=
http_ver + ' ' + IntToStr(result_code) + ' ' + error_msg + #13#10;
for I := 0 to respond_headers.Count do
respond_text := respond_text + respond_headers.Names[I] + ': ' +
respond_headers.ValueFromIndex[I] + #13#10;
respond_text := respond_text + #13#10 + respond_data;
sock.SendBuffer(@respond_text[1], Length(respond_text));
headers.Clear;
respond_headers.Clear;
respond_text := '';
end
else
Sleep(1);
until (Thread.Terminated or close_socket);
finally
respond_headers.Free;
gets.Free;
headers.Free;
S1.Free;
sock.Free;
end;
end;

You can send and receive data using easy to parse data like JSON, XML, BSON or binary data for data service, it is very flexible.

That's all for this article and I hope it's useful.

Arief Sujatmiko on Blogspot

Selasa, 16 Desember 2025

Creating Simple Web Server with Lazarus

Tidak ada komentar:

Creating Expert System for Database Application Development