pascal
/
freepascal.compiler
peilaus alkaen https://gitlab.com/freepascal.org/fpc/source.git


			
				
					
						
						
							123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131
							{*******************************************************************
*  Test library of the Apache Pascal Headers
*******************************************************************}
library mod_hello;

{$i define.inc}

uses SysUtils, httpd {$ifndef Apache1_3}, apr{$endif};

var
 test_module: module; {$ifdef Unix} public name 'test_module'; {$endif}

const
  MODULE_NAME = 'mod_hello.so';
  
{*******************************************************************
*  Free Pascal only supports exporting variables on Windows
*******************************************************************}
{$ifdef WINDOWS}
exports
 test_module name 'test_module';
{$endif}

{*******************************************************************
*  Handles apache requests
*******************************************************************}
function DefaultHandler(r: Prequest_rec): Integer; cdecl;
var
  RequestedHandler: string;
begin
  RequestedHandler := r^.handler;

  { We decline to handle a request if hello-handler is not the value of r->handler }
  if not SameText(RequestedHandler, 'testapache-handler') then
  begin
    Result := DECLINED;
    Exit;
  end;

  { The following line just prints a message to the errorlog }
  ap_log_error(MODULE_NAME, 54, APLOG_NOERRNO or APLOG_NOTICE,
   {$ifndef Apache1_3}0,{$endif} r^.server,
   'mod_hello: %s', [PChar('Before content is output')]);

  { We set the content type before doing anything else }
  {$ifdef Apache1_3}
    r^.content_type := 'text/html';
    ap_send_http_header(r);
  {$else}
    ap_set_content_type(r, 'text/html');
  {$endif}
  
  { 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. }
  if (r^.header_only <> 0) then
  begin
    Result := OK;
    Exit;
  end;

  { Now we just print the contents of the document using the
   ap_rputs and ap_rprintf functions. More information about
   the use of these can be found in http_protocol.inc }
  ap_rputs(DOCTYPE_HTML_4_0T, r);
  ap_rputs('<HTML>' + LineEnding, r);
  ap_rputs('<HEAD>' + LineEnding, r);
  ap_rputs('<TITLE>Hello There</TITLE>' + LineEnding, r);
  ap_rputs('</HEAD>' + LineEnding, r);
  ap_rputs('<BODY BGCOLOR="#FFFFFF">' + LineEnding ,r);
  ap_rputs('<H1>Hello world</H1>' + LineEnding, r);
  ap_rputs('This is the first Apache Module working with the new binding from Free Pascal' + LineEnding, r);
  ap_rprintf(r, '<br>A sample line generated by %s <br>' + LineEnding, [PChar('ap_rprintf')]);
  ap_rputs('</BODY></HTML>' + LineEnding, r);

  { We can either return OK or DECLINED at this point. If we return
         * OK, then no other modules will attempt to process this request }
  Result := OK;
end;

{*******************************************************************
*  Registers the hooks
*******************************************************************}
{$ifdef apache1_3}

procedure hw_init(s: PServer_rec; p: PPool); cdecl;
begin
end;

var
  hw_handlers: array[0..1] of handler_rec =
  (
    (content_type: 'testapache-handler'; handler: @DefaultHandler),
    (content_type: nil; handler: nil)
  );

{$else}

procedure RegisterHooks(p: Papr_pool_t); cdecl;
begin
  ap_hook_handler(@DefaultHandler, nil, nil, APR_HOOK_MIDDLE);
end;

{$endif}

{*******************************************************************
*  Library initialization code
*******************************************************************}
begin
  FillChar(test_module, SizeOf(test_module), 0);

  {$ifdef apache1_3}
    STANDARD_MODULE_STUFF(test_module);

    with test_module do
    begin
      name := MODULE_NAME;
      init := @hw_init;
      handlers := hw_handlers;
    end;
  {$else}
    STANDARD20_MODULE_STUFF(test_module);

    with test_module do
    begin
      name := MODULE_NAME;
      register_hooks := @RegisterHooks;
    end;
  {$endif}
end.