library mod_bvweb2;
{< Apache 2.4 module.
Based uppon https://gitlab.com/freepascal.org/fpc/source/-/blob/main/packages/httpd24/examples/mod_hello.pp?ref_type=heads
In this code I try to shows how to use three different handlers in a single Apache 2.4 module. The last example also
shows one way to collect paramters from the client. I have modified the code so to emphasize the use of UT8 character
encoding. I think it also will work on Apache running on Windows, but this is not tested in any way.
Disclaimer: I am not a professional programmer, so please take my statements with a grain of salt, maybe many grains. I
have done this for learning and exersice my pensionaire brain somewhat. The example use "brute force coding", meaning,
when it works, go further on, instead of beautification and optimizing.
Code is developed for and tested on:
- Ubuntu 24.04 (64 bit)
- Apache 2.4.58
- Using Lazarus 4.0. and and later on 4.2, both with Freepascal 3.2.2. Both Lazarus version will work just fine.
- For Lazarus, you may need to install LazWeb, found in OPM.
For the module to work, you need some configuration settings on the Apache server side. In this example on Ubuntu 24.04, you
first create the file "bvweb2.load" in the directory "/etc/apache2/mods-available" containing:
LoadModule bvweb-module2 /path-to/libmod_bvweb2.so
Then the file "bvweb2.conf", in the same directory, containing:
<IfModule bvweb-module2>
# handle files having .bv2 and .bv3 extensions
AddHandler bvweb-handler2 .bv2
AddHandler bvweb-handler3 .bv3
<Location "/func">
# handle everything from this directory
SetHandler bvweb-handler-func
</Location>
</IfModule>
Then you move to the directory "/etc/apache2/mods-enabled" and do the following to linking commands:
ln -s /etc/apache2/mods-available/bvweb2.load
ln -s /etc/apache2/mods-available/bvweb2.conf
And as the last thing, restart the apache server:
systemctl restart apache2
You may need root access for doing this. On other plattforms similar actions has to be done in an
apropriate way.
Test the result in a web reader calling it with something like http://server/test.bv2 or
http://server/test.bv2. You don't need a physical file for this. The handler will catch the call.
Nice readings:
https://httpd.apache.org/docs/2.4/developer/
https://httpd.apache.org/docs/2.4/developer/modguide.html
I strongly advice you to read the last one thoroughly.
}
{$mode ObjFPC}{$H+}
uses
Classes, SysUtils, httpd24, apr24;
const
AP24_MODULE_NAME = 'bvweb-module2'; // The module name
AP24_HANDLER_NAME = 'bvweb-handler2'; // You may have several handlers in one module. Remember those names has to be unique across all handlers seen from the Apache server
AP24_HANDLER_NAME2 = 'bvweb-handler3';
AP24_HANDLER_NAME_FUNC = 'bvweb-handler-func';
type
TKeyValuePair = record
key : PChar;
value : PChar;
end;
TKeyValueArray = array of TKeyValuePair;
PFormPair = ^ap_form_pair_t;
var
My_Module : module; {$ifdef unix} public name AP24_MODULE_NAME;{$endif}
exports
My_Module name AP24_MODULE_NAME;
//*********** Read POST ********************************************************//
{ This is a converted and rewritten C-code example from Apache 2.4. module API.
It is used to fetch the POST parameters.}
function readPost(var pairs : Papr_array_header_t): TKeyValueArray;
var
Mylen : apr_off_t = 0; // Signed 64 bit integer.
Size : apr_size_t; // Unsigned 64 bit integer.
I : Integer = 0; // Local counter.
buffer : PChar; // Buffer to held a single value.
pair : PFormPair; // To held a POST key/value pair.
MyRes : apr_status_t; // May not need this status variable. Length value??
begin
Result := nil;
I := 0;
while (pairs <> nil) and (apr_is_empty_array(pairs) = 0) do
begin
pair := PFormPair(apr_array_pop(pairs)); // Note that I think this is a destructive fetching process.
MyRes := apr_brigade_length(pair^.value, 1, @MyLen); // Finfd the length og POST value.
if MyRes <> 0 then Break; // Ich, an error. Hopefully never seen.
Size := apr_size_t(MyLen); // Just type convert length.
Getmem(buffer, size + 1); // Prepare for chr(0) ending.
apr_brigade_flatten(pair^.value, buffer, @size); // Length of POST variable.
buffer[Mylen] := #0; // Add PChar line ending, aka Char(0).
SetLength(Result,I + 1); // Adjust length of standard FPC dynamic array.
Result[I].key := pair^.name; // Copy key name foor value.
Result[I].value := buffer; // Copy value to array.
Inc(I);
if I >= 1000 then Break; // Just a safety plug for eventually run-away due to sloppy developer work. ;-)
end;
end;
//*********** Example 1 *********************************************************//
{ This is an example of userfunction you define yourself. I may be wise to create
an own unit collecting all procedures, functions and handling you want to use. }
procedure UserProcedure_1(var S : string; r : Prequest_rec);
var
MyFileName : string;
begin
MyFileName := r^.filename;
S := '<html>' + LineEnding
+ '<head>' + LineEnding
+ '<title>UserProcedure_1</title>' + LineEnding
+ '</head>' + LineEnding
+ '<body bgcolor="#ffffff">' + LineEnding
+ '<h1>Output from UserProcedure_1</h1>' + LineEnding
+ '<p>This is an Apache Module working with the binding from Free Pascal. Filename: ' + MyFileName + '.</p>' + LineEnding
+ '<p>Testing some norwegian special characters (2 byte sizes): ÆØÅ and æøå.</p>' + LineEnding
+ '</body></html>' + LineEnding ;
end;
//*********** Example 2 *********************************************************//
{ This is the second example of userfunction you define yourself. I may be wise to
instead create an own unit collecting all proceduresm functions and handling
you want to use. }
procedure UserProcedure_2 (var S : string; r : Prequest_rec);
var
SL : TStringList;
MyFileName : string;
begin
MyFileName := r^.filename;
SL := TStringList.Create;
try
with SL do
begin
Append('<html>');
Append('<head>');
Append('<title>UserProcedure_2</title>');
Append('</head>');
Append('<body bgcolor="#ffffff">');
Append('<h1>Output from UserProcedure_2</h1>');
Append('<p>This is an Apache Module working with the binding from Free Pascal. Filename: ' + MyFileName + '.</p>');
Append('<p>Testing some norwegian special characters (2 byte sizes): ÆØÅ and æøå.</p>');
Append('</body></html>');
end;
S := SL.Text;
finally
SL.Free;
end;
end;
//*********** Example 3 *********************************************************//
{ This is the third example of userfunction you define yourself. It show using a
directory has the triggering point. It also incorporates using parameters sent from
the client. It may be wise to create an own unit collecting all procedures,
functions and handling you want to use. }
procedure UserProcedure_Func(var S : string; r : Prequest_rec);
var
MyFileName : string;
MyArguments : string;
MyGetParam : string;
MyMethod : string;
MyHeaders : papr_table_t;
MyGetTable : papr_table_t;
MyPostTable : papr_array_header_t;
Fields : papr_array_header_t;
E : papr_table_entry_t;
N : Integer; // Helper variable.
P : Pointer; // Helper variable. Used to help me understanding the castings done. And also used for loop count.
Res : Integer; // Variable to keep status from parsing.
KvpArray : TKeyValueArray;
begin
MyFileName := r^.filename; // Not working for <Location>. Gives only location like "/func".
MyFileName := r^.uri; // Gives both location and filename like "/func/test.bv2".
MyArguments := r^.args; // Gives GET parameter(s) as one one PChar string (All after the ? mark).
MyMethod := r^.method; // Gives POST or GET in my examples. POST if POST and GET are both used.
MyHeaders := r^.headers_in; // Table with all headers.
Fields := apr_table_elts(MyHeaders);
P := Fields^.elts;
E := P;
N := Fields^.nelts;
ap_args_to_table(r,@MyGetTable);
Res := ap_parse_form_data(r, nil, @MyPostTable, High(apr_size_t), HUGE_STRING_LEN); // Apache API state using -1 as 4th parameter, meaning unlimited, even it is an unsigned integer type. Tells max size
MyGetParam := apr_table_get(MyGetTable, 'testparam');
S := '<html>' + LineEnding
+ '<head>' + LineEnding
+ '<title>UserProcedure_Func</title>' + LineEnding
+ '</head>' + LineEnding
+ '<body bgcolor="#ffffff">' + LineEnding
+ '<h1>Output from UserProcedure_3</h1>' + LineEnding
+ '<p>This is an Apache Module working with the binding from Free Pascal. URI: ' + MyFileName + '.</p>' + LineEnding
+ '<p>Testing some norwegian special characters (2 byte sizes): ÆØÅ and æøå.</p>' + LineEnding
+ '<p>Testing POST 1: <form action="http://vax02.local/func/test.bv2?testparam1=charlie" method="post">' + LineEnding
+ ' <label for="data1">Data 1:</label>' + LineEnding
+ ' <input type="text" id="data1" name="data1">' + LineEnding
+ ' <label for="data2">Data 2:</label>' + LineEnding
+ ' <input type="text" id="data2" name="data2">' + LineEnding
+ ' <input type="submit" value="Submit">' + LineEnding
+ '</form></p>' + LineEnding
+ '<p>This is a function called from location configuration for testing parameters.</p>' + LineEnding
+ '<p>GET parameter: testparam=' + MyGetParam + '.</p>' + LineEnding
+ '<p>Arguments: ' + MyArguments + '.</p>' + LineEnding
+ '<p>Method: ' + MyMethod + '.</p>' + LineEnding
+ '<p>Header count: ' + IntToStr(N) + '.</p>' + LineEnding;
for N := 0 to N - 1 do
begin
S := S + 'Header ' + IntToStr(N) + ': ' + E[N].key + ' = ' + E[N].val + '<br>' + LineEnding; // List all headings with key and values.
end;
if (Res = OK) and (MyPostTable^.nelts > 0) then
begin
S := S + '<p>Found ' + IntToStr(MyPostTable^.nelts) + ' POST parameter(s)!</p>' + LineEnding;
S := S + '<p>Length of POST section: ' + IntToStr(MemSize(MyPostTable)) + '.</p>' + LineEnding; // Wonder if this is correct! Seems a bit strange.
S := S + '<p>Found the following POST parameter(s):</p>' + LineEnding;
if (Res = OK) or (MyPostTable <> nil) then
begin
KvpArray := readPost(MyPostTable);
for N := 0 to Length(KvpArray) - 1 do
begin
S := S + '<p>Key ' + IntToStr(N) + ': ' + KvpArray[N].key + ', Value ' + IntToStr(N) + ': ' + KvpArray[N].value + '.</p>' + LineEnding;
end;
end;
end;
S := S + '</body></html>' + LineEnding;
end;
{ This is the function that handles requests from the Pache server. The apache server will
call every module in turn until one module handles the request represented by the handler name. }
function MyHandler(r : Prequest_rec): Integer; cdecl;
var
RequestedHandler : string;
S : string = '';
begin
RequestedHandler := r^.handler;
if not (SameText(RequestedHandler, AP24_HANDLER_NAME) or
SameText(RequestedHandler, AP24_HANDLER_NAME2) or
SameText(RequestedHandler, AP24_HANDLER_NAME_FUNC)
) then // May have several handlers. Then several tests. If no match, exit imidiate.
begin
Result := DECLINED;
Exit; // Do not handle and return to the Apache server.
end;
{ The following line just prints a message to the errorlog }
ap_log_error(AP24_MODULE_NAME, // The file in which this function is called
40, // The line number on which this function is called
0, // The module_index of the module generating this message
APLOG_NOERRNO or APLOG_NOTICE, // The level of this error message
0, // The status code from the previous command
r^.server, // The server on which we are logging
AP24_MODULE_NAME+': %s', // The format string
[PAnsiChar('Handler: '+RequestedHandler+'. Before content is output!')]); //The arguments to use to fill out fmt.
ap_set_content_type(r, 'text/html;charset=utf8'); // Set page character encoding to UTF8.
{ If the request is for a header only, and not a request for the whole content, then return
OK now. We don't have to do anything else. According to the Apache documentation, setting
Result := DONE the server will not further continue to process the request. The result OK
may let the server to do more processing in other handlers, typically the logging handle.}
if (r^.header_only <> 0) then
begin
Result := OK;
Exit;
end;
{ Now we just print the contents of the document using the ap_rwrite. More
information about the use of these can be found in http_protocol.inc. Sometimes
you will prefere using ap_rputs() function, like ap_rputs('A text string',r).
A simple case statement is useful for selecting correct process based upon the
handler name.}
case RequestedHandler of
AP24_HANDLER_NAME : UserProcedure_1(S,r);
AP24_HANDLER_NAME2 : UserProcedure_2(S,r);
AP24_HANDLER_NAME_FUNC : UserProcedure_Func(S,r);
end;
ap_rwrite(PUTF8String(S),Length(S), r);
{ We can either return OK, DONE or DECLINED at this point. If we return DONE, then
no other modules will attempt to process this request }
Result := OK;
end;
{*******************************************************************
* Registers the hooks
*******************************************************************}
procedure RegisterHooks(p: Papr_pool_t); cdecl;
begin
ap_hook_handler(@MyHandler, nil, nil, APR_HOOK_MIDDLE);
end;
{*******************************************************************
* Library initialization code
*******************************************************************}
begin
Initialize(My_Module);
FillChar(My_Module, SizeOf(My_Module),0); // Will test if only Initialize() is enough
STANDARD20_MODULE_STUFF(My_Module); // Yes, same structure as Apache 2.4.
with My_Module do
begin
name := AP24_MODULE_NAME;
register_hooks := @RegisterHooks;
end;
end.
Recent
