1{******************************************************************* 2* Test library of the Apache Pascal Headers 3*******************************************************************} 4library mod_hello; 5 6{******************************************************************* 7* The mode must be objfpc on this unit because the unix code uses 8* some extensions introduced on Free Pascal 9*******************************************************************} 10{$ifdef fpc} 11 {$mode objfpc}{$H+} 12{$endif} 13 14{$IFDEF WIN32} 15 {$DEFINE WINDOWS} 16{$ENDIF} 17 18{$define Apache2_2} 19 20uses SysUtils, httpd {$ifndef Apache1_3}, apr{$endif}; 21 22var 23 test_module: module; public name 'hello_module'; 24 default_module_ptr: Pmodule; 25 26const 27 MODULE_NAME = 'mod_hello.so'; 28 29{******************************************************************* 30* Free Pascal only supports exporting variables on Windows 31*******************************************************************} 32{$ifdef WINDOWS} 33exports 34 test_module name 'test_module'; 35{$endif} 36 37{******************************************************************* 38* Handles apache requests 39*******************************************************************} 40function DefaultHandler(r: Prequest_rec): Integer; cdecl; 41var 42 RequestedHandler: string; 43 44begin 45 RequestedHandler := r^.handler; 46 47 { We decline to handle a request if hello-handler is not the value of r->handler } 48 if not SameText(RequestedHandler, 'testapache-handler') then 49 begin 50 Result := DECLINED; 51 Exit; 52 end; 53 54 { The following line just prints a message to the errorlog } 55 ap_log_error(MODULE_NAME, 54, APLOG_NOERRNO or APLOG_NOTICE, 56 {$ifndef Apache1_3}0,{$endif} r^.server, 57 'mod_hello: %s', [PChar('Before content is output')]); 58 59 { We set the content type before doing anything else } 60 {$ifdef Apache1_3} 61 r^.content_type := 'text/html'; 62// ap_send_http_header(r); 63 {$else} 64 ap_set_content_type(r, 'text/html'); 65 {$endif} 66 67 { If the request is for a header only, and not a request for 68 the whole content, then return OK now. We don't have to do 69 anything else. } 70 if (r^.header_only <> 0) then 71 begin 72 Result := OK; 73 Exit; 74 end; 75 76 { Now we just print the contents of the document using the 77 ap_rputs and ap_rprintf functions. More information about 78 the use of these can be found in http_protocol.inc } 79 ap_rputs('<HTML>' + LineEnding, r); 80 ap_rputs('<HEAD>' + LineEnding, r); 81 ap_rputs('<TITLE>Hello There</TITLE>' + LineEnding, r); 82 ap_rputs('</HEAD>' + LineEnding, r); 83 ap_rputs('<BODY BGCOLOR="#FFFFFF">' + LineEnding ,r); 84 ap_rputs('<H1>Hello world</H1>' + LineEnding, r); 85 ap_rputs('This is the first Apache Module working with the new binding from Free Pascal' + LineEnding, r); 86// ap_rprintf(r, '<br>A sample line generated by ap_rprintf<br>' + LineEnding, []); 87 ap_rputs('</BODY></HTML>' + LineEnding, r); 88 89 { We can either return OK or DECLINED at this point. If we return 90 * OK, then no other modules will attempt to process this request } 91 Result := OK; 92end; 93 94{******************************************************************* 95* Registers the hooks 96*******************************************************************} 97{$ifdef apache1_3} 98 99procedure hw_init(s: PServer_rec; p: PPool); cdecl; 100begin 101end; 102 103var 104 hw_handlers: array[0..0] of handler_rec = 105 ( 106 (content_type: 'hw_app'; handler: @DefaultHandler) 107 ); 108 109{$else} 110 111procedure RegisterHooks(p: Papr_pool_t); cdecl; 112begin 113 ap_hook_handler(@DefaultHandler, nil, nil, APR_HOOK_MIDDLE); 114end; 115 116{$endif} 117 118{******************************************************************* 119* Library initialization code 120*******************************************************************} 121 122begin 123 default_module_ptr := @test_module; 124 FillChar(default_module_ptr^, SizeOf(default_module_ptr^), 0); 125 {$ifdef apache1_3} 126 STANDARD_MODULE_STUFF(test_module); 127 128 with test_module do 129 begin 130 name := MODULE_NAME; 131 init := @hw_init; 132 handlers := hw_handlers; 133 end; 134 {$else} 135 STANDARD20_MODULE_STUFF(test_module); 136 137 with test_module do 138 begin 139 name := MODULE_NAME; 140 register_hooks := @RegisterHooks; 141 end; 142 {$endif} 143end. 144