program microrestserver;
{$mode objfpc}{$H+}
{$define THREADPOOL}
uses
ctypes, sysutils, classes, baseunix, unixtype, pthreads,
fpjson, jsonparser, libmicrohttpd;
const
DEFAULTPORT = 8080;
var
PORT:Cardinal = DEFAULTPORT;
server: PMHD_Daemon;
should_shutdown: boolean = False;
shutdown_mutex: pthread_mutex_t;
type
TConnectionInfo = record
post_data: string;
json_data: TJSONData; // For JSON payloads
end;
PConnectionInfo = ^TConnectionInfo;
procedure InitializeMutex;
begin
if pthread_mutex_init(@shutdown_mutex, nil) <> 0 then
begin
WriteLn('Error initializing mutex');
Halt(1);
end;
end;
function CreateJsonResponse(const Method, Message: string): string;
var
json: TJSONObject;
begin
json := TJSONObject.Create;
try
json.Add('method', Method);
json.Add('message', Message);
Result := json.AsJSON;
finally
json.Free;
end;
end;
function HandleRestfulRequest(cls: Pointer; connection: PMHD_Connection;
url: PChar; method: PChar; version: PChar; upload_data: PChar;
upload_data_size: PCsize_t; ptr: PPointer): cint; cdecl;
var
response: PMHD_Response;
ret: cint;
con_info: PConnectionInfo;
status: string;
json_response: string;
begin
// Initialize or get connection-specific data
if ptr^ = nil then
begin
// First call for this connection
New(con_info);
con_info^.post_data := '';
con_info^.json_data := nil;
ptr^ := con_info;
Exit(MHD_YES);
end;
con_info := PConnectionInfo(ptr^);
// Handle POST data
if (upload_data_size^ <> 0) and (method = 'POST') then
begin
con_info^.post_data := upload_data;
// Try to parse as JSON if content-type is application/json
if Assigned(MHD_lookup_connection_value(connection, MHD_HEADER_KIND, 'Content-Type')) and
(Pos('application/json', MHD_lookup_connection_value(connection, MHD_HEADER_KIND, 'Content-Type')) > 0) then
begin
if Assigned(con_info^.json_data) then
con_info^.json_data.Free;
try
con_info^.json_data := GetJSON(con_info^.post_data);
except
on E: Exception do
con_info^.json_data := nil;
end;
end;
upload_data_size^ := 0;
Exit(MHD_YES);
end;
// Prepare responses based on URL and method
if (url = '/shutdown') and (method = 'GET') then
begin
// Thread-safe shutdown flag update
pthread_mutex_lock(@shutdown_mutex);
should_shutdown := True;
pthread_mutex_unlock(@shutdown_mutex);
response := MHD_create_response_from_buffer(0, nil, MHD_RESPMEM_PERSISTENT);
ret := MHD_queue_response(connection, MHD_HTTP_OK, response);
MHD_destroy_response(response);
// Cleanup connection info
if Assigned(con_info^.json_data) then
con_info^.json_data.Free;
Dispose(con_info);
ptr^ := nil;
Result := ret;
end
else if (url = '/status') and (method = 'GET') then
begin
status := CreateJsonResponse('GET', 'Server status: running, time: ' + DateTimeToStr(Now));
response := MHD_create_response_from_buffer(
Length(status),
PChar(status),
MHD_RESPMEM_MUST_COPY
);
MHD_add_response_header(response, 'Content-Type', 'application/json');
ret := MHD_queue_response(connection, MHD_HTTP_OK, response);
MHD_destroy_response(response);
// Cleanup connection info
if Assigned(con_info^.json_data) then
con_info^.json_data.Free;
Dispose(con_info);
ptr^ := nil;
Result := ret;
end
else if (url = '/api/echo') then
begin
if (method = 'GET') then
begin
json_response := CreateJsonResponse('GET', 'echo');
end
else if (method = 'POST') then
begin
if Assigned(con_info^.json_data) then
json_response := con_info^.json_data.AsJSON
else
json_response := CreateJsonResponse('POST', con_info^.post_data);
end
else
begin
// Unsupported method
response := MHD_create_response_from_buffer(0, nil, MHD_RESPMEM_PERSISTENT);
ret := MHD_queue_response(connection, MHD_HTTP_METHOD_NOT_ALLOWED, response);
MHD_destroy_response(response);
// Cleanup connection info
if Assigned(con_info^.json_data) then
con_info^.json_data.Free;
Dispose(con_info);
ptr^ := nil;
Result := ret;
Exit;
end;
response := MHD_create_response_from_buffer(
Length(json_response),
PChar(json_response),
MHD_RESPMEM_MUST_COPY
);
MHD_add_response_header(response, 'Content-Type', 'application/json');
ret := MHD_queue_response(connection, MHD_HTTP_OK, response);
MHD_destroy_response(response);
// Cleanup connection info
if Assigned(con_info^.json_data) then
con_info^.json_data.Free;
Dispose(con_info);
ptr^ := nil;
Result := ret;
end
else
begin
// Not found
response := MHD_create_response_from_buffer(0, nil, MHD_RESPMEM_PERSISTENT);
ret := MHD_queue_response(connection, MHD_HTTP_NOT_FOUND, response);
MHD_destroy_response(response);
// Cleanup connection info
if Assigned(con_info^.json_data) then
con_info^.json_data.Free;
Dispose(con_info);
ptr^ := nil;
Result := ret;
end;
end;
begin
// Initialize mutex properly
InitializeMutex;
If ParamCount > 0 then
begin
// try to read a port at Paramstr(1),
// if it fails, use the default port
PORT := StrToIntDef(ParamStr(1), DEFAULTPORT);
end
else
PORT :=DEFAULTPORT;
// Create the MHD daemon with either thread pool OR thread-per-connection
// Choose one of these options:
// Option 1: Thread pool (fixed number of threads)
{$if Defined(THREADPOOL)}
server := MHD_start_daemon(
MHD_USE_INTERNAL_POLLING_THREAD or MHD_USE_DEBUG,
PORT,
nil,
nil,
@HandleRestfulRequest,
nil,
MHD_OPTION_THREAD_POOL_SIZE, 4,
MHD_OPTION_END
);
{$else thread_per_connection}
// Option 2: Thread-per-connection (one thread per request)
server := MHD_start_daemon(
MHD_USE_THREAD_PER_CONNECTION or MHD_USE_DEBUG or MHD_USE_INTERNAL_POLLING_THREAD,
PORT,
nil,
nil,
@HandleRestfulRequest,
nil,
MHD_OPTION_END
);
{$ifend}
if (server = nil) then
begin
WriteLn('Error starting server');
Halt(1);
end;
Writeln('-----------------');
Writeln('Micro Rest Server');
Writeln('-----------------');
Writeln('You can specify a port number on the command line.');
Writeln('If it not a valid port, the default port 8080 will');
Writeln('be used.');
Writeln;
WriteLn('Server running on port ', PORT);
WriteLn('Endpoints:');
WriteLn(' GET /status - Returns server status');
WriteLn(' GET /shutdown - Stops the server');
WriteLn(' GET /api/echo - Simple echo response');
WriteLn(' POST /api/echo - Echoes back POST data');
// Main loop
while True do
begin
Sleep(100);
pthread_mutex_lock(@shutdown_mutex);
if should_shutdown then
begin
pthread_mutex_unlock(@shutdown_mutex);
Break;
end;
pthread_mutex_unlock(@shutdown_mutex);
end;
writeln;
// Clean up
MHD_stop_daemon(server);
pthread_mutex_destroy(@shutdown_mutex);
WriteLn('Server stopped');
end.
WIKI Timeout issues
