Создание простого RESTful JSON сервера на Delphi/Pascal с libmicrohttpd
В этой статье мы рассмотрим, как создать простой, но функциональный RESTful JSON сервер на Object Pascal (Delphi/Free Pascal) с использованием библиотеки libmicrohttpd. Этот пример послужит хорошей основой для разработки более сложных микросервисов.
Проблема и решение
Исходный код, представленный пользователем nomorelogic на форуме, демонстрировал проблему с обработкой POST-запросов - сервер не возвращал ожидаемый ответ. Как выяснилось, проблема заключалась в неправильной обработке данных, которые могут передаваться частями.
Основные проблемы исходного кода:
Неполная обработка POST-данных
Отсутствие правильного управления контекстом соединения
Проблемы с потокобезопасностью при завершении работы сервера
Улучшенное решение
Рассмотрим улучшенную версию кода, которая решает эти проблемы:
program restfulhttpserverthreadsafe;
{$mode objfpc}{$H+}
{$define THREADPOOL}
uses
cthreads,
Classes,
SysUtils,
cmem,
libmicrohttpd,
fpjson,
jsonparser,
syncobjs;
const
PORT = 8888;
type
TRestResponse = record
StatusCode: cuint;
ResText: string;
end;
TClientContextInfo = record
Playload_AsText: string;
PlayLoadIsJson: boolean;
PlayLoad_AsJson: TJSONObject;
Response: TRestResponse;
end;
PClientContextInfo = ^TClientContextInfo;
var
ShouldStop: boolean = False;
Daemon: PMHD_Daemon;
StopLock: TCriticalSection;
function HandleRestfulRequest(cls: Pointer; connection: PMHD_Connection;
url, method, version: pchar; upload_data: pchar; upload_data_size: pSize_t;
con_cls: PPointer): cint; cdecl;
var
response: PMHD_Response;
jsonObj: TJSONObject;
con_info: PClientContextInfo;
begin
Result := 0;
// Инициализация контекста соединения при первом вызове
if con_cls^ = nil then
begin
New(con_info);
con_info^.Playload_AsText := '';
con_info^.PlayLoadIsJson := False;
con_info^.PlayLoad_AsJson := nil;
con_info^.Response.StatusCode := MHD_HTTP_OK;
con_info^.Response.ResText := '';
con_cls^ := con_info;
Exit(MHD_YES);
end;
con_info := PClientContextInfo(con_cls^);
// Обработка POST-данных
if (method = MHD_HTTP_METHOD_POST) and (upload_data_size^ <> 0) then
begin
SetString(con_info^.Playload_AsText, upload_data, upload_data_size^);
// Попытка разбора JSON, если указан соответствующий Content-Type
if Assigned(MHD_lookup_connection_value(connection, MHD_HEADER_KIND,
MHD_HTTP_HEADER_CONTENT_TYPE)) then
if (Pos('application/json',
MHD_lookup_connection_value(connection, MHD_HEADER_KIND,
MHD_HTTP_HEADER_CONTENT_TYPE)) > 0) then
begin
if con_info^.Playload_AsText <> '' then
try
con_info^.PlayLoadIsJson := True;
con_info^.PlayLoad_AsJson :=
GetJSON(con_info^.Playload_AsText) as TJSONObject;
except
con_info^.Response.StatusCode := MHD_HTTP_INTERNAL_SERVER_ERROR;
con_info^.Response.ResText := '{"error": "Invalid JSON format"}';
end;
end;
upload_data_size^ := 0;
Exit(MHD_YES);
end;
// Обработка запросов и формирование ответа
if con_info^.Response.StatusCode = MHD_HTTP_OK then
begin
if url = '/shutdown' then
begin
jsonObj := TJSONObject.Create;
jsonObj.Add('status', 'shutting down');
con_info^.Response.ResText := jsonObj.AsJSON;
jsonObj.Free;
StopLock.Enter;
try
ShouldStop := True;
finally
StopLock.Leave;
end;
end
else if (url = '/api/status') and (method = 'GET') then
begin
jsonObj := TJSONObject.Create;
jsonObj.Add('status', 'ok');
jsonObj.Add('uptime', FormatDateTime('hh:nn:ss', Now));
con_info^.Response.ResText := jsonObj.AsJSON;
jsonObj.Free;
end
else if url = '/api/echo' then
begin
if method = 'GET' then
begin
con_info^.Response.ResText := '{"method": "GET", "data": "echo"}';
end
else if method = 'POST' then
begin
if con_info^.PlayLoadIsJson then
begin
if Assigned(con_info^.PlayLoad_AsJson) then
con_info^.Response.ResText := con_info^.PlayLoad_AsJson.AsJSON;
end
else
begin
con_info^.Response.ResText := con_info^.Playload_AsText;
end;
if con_info^.Response.ResText = '' then
begin
con_info^.Response.StatusCode := MHD_HTTP_NO_CONTENT;
con_info^.Response.ResText := '{"error": "No data received"}';
end;
end;
end;
end;
// Формирование и отправка ответа
response := MHD_create_response_from_buffer(Length(con_info^.Response.ResText),
PChar(con_info^.Response.ResText), MHD_RESPMEM_MUST_COPY);
MHD_add_response_header(response, 'Content-Type', 'application/json');
Result := MHD_queue_response(connection, con_info^.Response.StatusCode, response);
// Освобождение ресурсов
MHD_destroy_response(response);
if Assigned(con_info^.PlayLoad_AsJson) then
con_info^.PlayLoad_AsJson.Free;
Dispose(con_info);
con_cls^ := nil;
end;
begin
StopLock := TCriticalSection.Create;
try
{$if Defined(THREADPOOL)}
Daemon := 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}
Daemon := 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 Daemon = nil then
begin
WriteLn('Error starting HTTP server!');
Halt(1);
end;
WriteLn('REST server started at: http://localhost:', PORT);
WriteLn('Endpoints:');
WriteLn(' GET /api/status - Server status');
WriteLn(' GET /api/echo - Simple echo');
WriteLn(' POST /api/echo - Echo back POST data');
WriteLn(' GET /shutdown - Stop server');
while not ShouldStop do
Sleep(100);
MHD_stop_daemon(Daemon);
WriteLn('Server stopped.');
finally
StopLock.Free;
end;
end.
Ключевые особенности решения
Правильная обработка контекста соединения:
Для каждого соединения создается структура TClientContextInfo
Данные сохраняются между вызовами callback-функции
Корректная обработка POST-запросов:
Данные собираются полностью перед обработкой
Поддержка JSON с автоматическим парсингом
Потокобезопасность:
Использование TCriticalSection для защиты общих ресурсов
Возможность выбора модели потоков (пул или поток на соединение)
Гибкая система ответов:
Поддержка различных HTTP-статусов
Автоматическое формирование JSON-ответов
Примеры использования
Сервер поддерживает несколько endpoint'ов:
# Получить статус сервера
curl -X GET http://localhost:8888/api/status
# Эхо GET-запрос
curl -X GET http://localhost:8888/api/echo
# Эхо POST-запрос с JSON
curl -X POST -H "Content-Type: application/json" -d '{"message":"test"}' http://localhost:8888/api/echo
# Остановка сервера
curl -X GET http://localhost:8888/shutdown
Дальнейшие улучшения
Логирование - добавление системы логирования запросов и ошибок
Конфигурация - вынесение параметров сервера в конфигурационный файл
Маршрутизация - реализация более сложной системы маршрутизации запросов
Этот пример демонстрирует, как с помощью libmicrohttpd и Object Pascal можно создать легковесный, но функциональный RESTful сервер, который может служить основой для более сложных решений.
Статья описывает создание RESTful JSON сервера на Delphi/Pascal с использованием libmicrohttpd, включая решение проблем с обработкой POST-запросов, управлением контекстом и потокобезопасностью.
Комментарии и вопросы
Получайте свежие новости и обновления по Object Pascal, Delphi и Lazarus прямо в свой смартфон. Подпишитесь на наш Telegram-канал delphi_kansoftware и будьте в курсе последних тенденций в разработке под Linux, Windows, Android и iOS
Telegram-канал