297 lines
8.4 KiB
ObjectPascal
297 lines
8.4 KiB
ObjectPascal
program lms_cgi;
|
|
|
|
{$mode objfpc}{$H+}
|
|
|
|
uses
|
|
{$IFDEF UNIX}
|
|
cthreads,
|
|
{$ENDIF}
|
|
{$IFDEF HASAMIGA}
|
|
athreads,
|
|
{$ENDIF}
|
|
Interfaces, Classes, SysUtils, inifiles, httpDefs, fpweb, custweb, custcgi,
|
|
lnetbase, tcpClient, tcpthreadhelper, extTypes, eventlog;
|
|
|
|
Type
|
|
|
|
{ TMyCGIHandler }
|
|
|
|
TMyCGIHandler = Class(TCgiHandler)
|
|
Private
|
|
fAnswer: string;
|
|
fMode: byte;
|
|
fCode: DWORD;
|
|
fParam: QWORD;
|
|
fValues: TStrings;
|
|
fData: TStream;
|
|
function answerReady(Sender: TMainThread; const mode: byte;
|
|
const Code:DWORD; const QValue: QWORD; const Answer: string; const Values: TStrings; const iValues: TParamArray; const Data: TStream): boolean;
|
|
Public
|
|
Procedure HandleRequest(ARequest : Trequest; AResponse : TResponse); override;
|
|
procedure log(ALevel: TLogLevel; Sender: TObject; msg: string);
|
|
end;
|
|
|
|
|
|
{ TMyCGIApp }
|
|
|
|
TMyCGIApp = Class(TCustomCGIApplication)
|
|
private
|
|
flogFolder: string;
|
|
fHost: string;
|
|
fPort: integer;
|
|
flogger: TEventLog;
|
|
procedure LoadConfig;
|
|
Protected
|
|
function InitializeWebHandler: TWebHandler; override;
|
|
public
|
|
procedure Test;
|
|
constructor CreateWithLogger(AOwner: TComponent);
|
|
destructor Destroy; override;
|
|
property Host: string read fHost;
|
|
property Port: integer read fPort;
|
|
property LogFolder: string read fLogFolder;
|
|
property Logger: TEventLog read flogger;
|
|
procedure log(ALevel: TLogLevel; Sender: TObject; msg: string);
|
|
end;
|
|
|
|
const
|
|
aTypes: array[0..3] of string=('"UNKNOWN"','"REQUEST"','"ANSWER"','"ERROR"');
|
|
|
|
function TMyCGIHandler.answerReady(Sender: TMainThread; const mode: byte;
|
|
const Code: DWORD; const QValue: QWORD; const Answer: string;
|
|
const Values: TStrings; const iValues: TParamArray; const Data: TStream
|
|
): boolean;
|
|
begin
|
|
log(mtExtra,self,'AnswerReady');
|
|
fAnswer:=Answer;
|
|
fMode:=mode;
|
|
fCode:=code;
|
|
fParam:=QValue;
|
|
if assigned(Values) then
|
|
begin
|
|
fValues:=TStringList.Create;
|
|
fValues.assign(Values);
|
|
end;
|
|
if assigned(Data) then
|
|
begin
|
|
fData := TMemoryStream.Create;
|
|
Data.seek(0,soFromBeginning);
|
|
fData.CopyFrom(Data,Data.Size);
|
|
end;
|
|
log(mtExtra,self,'AnswerReady.done');
|
|
end;
|
|
|
|
procedure TMyCGIHandler.HandleRequest(ARequest: Trequest; AResponse: TResponse);
|
|
var
|
|
clt: TClientMainThread;
|
|
i: integer;
|
|
k,v: string;
|
|
allfields: TStrings;
|
|
begin
|
|
|
|
{$IFDEF DEBUG}
|
|
log(mtDebug,self,'Command '+ARequest.Command);
|
|
log(mtDebug,self,'RemoteAddr '+ARequest.RemoteAddr);
|
|
log(mtDebug,self,'RemoteAddress '+ARequest.RemoteAddress);
|
|
log(mtDebug,self,'CommandLine '+ARequest.CommandLine);
|
|
log(mtDebug,self,'ContentRange '+ARequest.ContentRange);
|
|
log(mtDebug,self,'HeaderLine '+ARequest.HeaderLine);
|
|
log(mtDebug,self,'QueryString '+ARequest.QueryString);
|
|
log(mtDebug,self,'Authorization '+ARequest.Authorization);
|
|
log(mtDebug,self,'Connection '+ARequest.Connection);
|
|
log(mtDebug,self,'WWWAuthenticate '+ARequest.WWWAuthenticate);
|
|
log(mtDebug,self,'Content '+ARequest.Content);
|
|
log(mtDebug,self,'ContentType '+ARequest.ContentType);
|
|
log(mtDebug,self,'From '+ARequest.From);
|
|
log(mtDebug,self,'UserAgent '+ARequest.UserAgent);
|
|
log(mtDebug,self,'URI '+ARequest.URI);
|
|
log(mtDebug,self,'URL '+ARequest.URL);
|
|
log(mtDebug,self,'ContentEncoding '+ARequest.ContentEncoding);
|
|
log(mtDebug,self,'ContentLanguage '+ARequest.ContentLanguage);
|
|
log(mtDebug,self,'Query '+ARequest.Query);
|
|
log(mtDebug,self,'Location '+ARequest.Location);
|
|
log(mtDebug,self,'Method '+ARequest.Method);
|
|
log(mtDebug,self,'PathInfo '+ARequest.PathInfo);
|
|
log(mtDebug,self,'Referer '+ARequest.Referer);
|
|
|
|
LogStrings(mtInfo, @log,self,'QueryFields',Arequest.QueryFields);
|
|
LogStrings(mtInfo, @log,self,'ContentFields',Arequest.ContentFields);
|
|
LogStrings(mtInfo, @log,self,'CookieFields',Arequest.CookieFields);
|
|
LogStrings(mtInfo, @log,self,'CustomHeaders',Arequest.CustomHeaders);
|
|
{$ENDIF}
|
|
if ARequest.QueryFields.Values['action']='' then
|
|
begin
|
|
AResponse.ContentType := 'text/html';
|
|
AResponse.Contents.add('<h2>QueryFields</h2>');
|
|
AResponse.Contents.add('<dl>');
|
|
for i := 0 to ARequest.QueryFields.Count-1 do
|
|
begin
|
|
k := ARequest.QueryFields.Names[i];
|
|
v := ARequest.QueryFields.Values[k];
|
|
AResponse.Contents.add(format('<dt>%s</dt><dd>%s</dd>',[k,v]));
|
|
|
|
end;
|
|
AResponse.Contents.add('</dl>');
|
|
AResponse.Contents.add('');
|
|
AResponse.Contents.add('<h2>ContentFields</h2>');
|
|
AResponse.Contents.add('<dl>');
|
|
for i := 0 to ARequest.ContentFields.Count-1 do
|
|
begin
|
|
k := ARequest.ContentFields.Names[i];
|
|
v := ARequest.ContentFields.Values[k];
|
|
AResponse.Contents.add(format('<dt>%s</dt><dd>%s</dd>',[k,v]));
|
|
|
|
end;
|
|
AResponse.Contents.add('</dl>');
|
|
AResponse.Contents.add('');
|
|
AResponse.SendContent;
|
|
exit;
|
|
end;
|
|
allfields := TStringList.Create;
|
|
try
|
|
allfields.AddStrings(ARequest.QueryFields);
|
|
allfields.AddStrings(ARequest.ContentFields);
|
|
log(mtDebug,self,'fields');
|
|
clt := TClientMainThread.Create(ARequest.QueryFields.Values['action'],allfields,@Log,(Owner as TMyCGIApp).Host,(Owner as TMyCGIApp).Port,@answerReady);
|
|
try
|
|
log(mtExtra,self,'create thread');
|
|
clt.start;
|
|
log(mtExtra,self,'thread started');
|
|
clt.waitFor;
|
|
|
|
finally
|
|
log(mtExtra,self,'thread finished');
|
|
clt.free;
|
|
end;
|
|
|
|
finally
|
|
allfields.free;
|
|
end;
|
|
{$IFDEF DEBUG}
|
|
log(mtDebug,self,'Data READY');
|
|
log(mtDebug,self,'Mode '+ inttostr(fMode));
|
|
log(mtDebug,self,'Code '+ inttostr(fCode));
|
|
log(mtDebug,self,'Answer '+fAnswer);
|
|
log(mtDebug,self,'Param '+ inttostr(fParam));
|
|
if assigned(fValues) then
|
|
LogStrings(mtDebug,@log,self,'VALUES',fValues);
|
|
{$ENDIF}
|
|
if not assigned(fData) then
|
|
begin
|
|
AResponse.ContentType := 'application/json';
|
|
AResponse.Contents.add('{');
|
|
AResponse.Contents.add('"type":'+aTypes[fMode]+',');
|
|
AResponse.Contents.add('"code":'+inttostr(fCode)+',');
|
|
AResponse.Contents.add('"value":'+inttostr(fParam)+',');
|
|
AResponse.Contents.add('"name":"'+(fAnswer)+'"');
|
|
if assigned(fValues) then
|
|
begin
|
|
AResponse.Contents.add(',"values":[');
|
|
if fValues.count>0 then
|
|
AResponse.Contents.Add(fValues[0]);
|
|
for i := 1 to fValues.Count-1 do
|
|
begin
|
|
AResponse.Contents.Add(','+fValues[i]);
|
|
end;
|
|
AResponse.Contents.add(']');
|
|
fValues.Free;
|
|
end;
|
|
AResponse.Contents.add('}');
|
|
end
|
|
else
|
|
begin
|
|
AResponse.FreeContentStream := true;
|
|
AResponse.ContentType:='application/pdf';
|
|
fData.Seek(0,soFromBeginning);
|
|
AResponse.ContentStream := fData;
|
|
end;
|
|
log(mtDebug,self,'Sending');
|
|
AResponse.SendContent;
|
|
log(mtDebug,self,'Sent');
|
|
end;
|
|
|
|
procedure TMyCGIHandler.log(ALevel: TLogLevel; Sender: TObject; msg: string);
|
|
begin
|
|
(Owner as TMyCGIApp).Log(ALevel,Sender,msg);
|
|
end;
|
|
|
|
procedure TMyCGIApp.LoadConfig;
|
|
var
|
|
ini: TIniFile;
|
|
begin
|
|
ini := TIniFile.Create(ChangeFileExt(ParamStr(0),'.ini'));
|
|
try
|
|
fHost := ini.ReadString('PARAMS','host','localhost');
|
|
fPort := ini.ReadInteger('PARAMS','port',6543);
|
|
flogFolder:=ini.ReadString('PARAMS','log','');
|
|
finally
|
|
ini.free;
|
|
end;
|
|
end;
|
|
|
|
function TMyCGIApp.InitializeWebHandler: TWebHandler;
|
|
begin
|
|
LoadConfig;
|
|
if assigned(flogger) then
|
|
begin
|
|
flogger.FileName:=LogFolder;
|
|
flogger.Active:=true;
|
|
flogger.Info('start');
|
|
end;
|
|
Result:=TMyCgiHandler.Create(self);
|
|
end;
|
|
|
|
procedure TMyCGIApp.Test;
|
|
var
|
|
clt: TClientMainThread;
|
|
begin
|
|
clt := TClientMainThread.Create('reports',nil,@Log,'10.120.7.20',6543,nil);
|
|
try
|
|
clt.start;
|
|
clt.waitFor;
|
|
finally
|
|
clt.free;
|
|
end;
|
|
end;
|
|
|
|
constructor TMyCGIApp.CreateWithLogger(AOwner: TComponent);
|
|
begin
|
|
flogger := TEventLog.Create(self);
|
|
flogger.Identification:='lms_cgi_client';
|
|
flogger.LogType:={$IFDEF LINUX}ltSystem{$ELSE}ltFile{$ENDIF};
|
|
inherited Create(AOwner);
|
|
|
|
end;
|
|
|
|
destructor TMyCGIApp.Destroy;
|
|
begin
|
|
if assigned(flogger) then
|
|
FreeAndNil(flogger);
|
|
inherited Destroy;
|
|
end;
|
|
|
|
procedure TMyCGIApp.log(ALevel: TLogLevel; Sender: TObject; msg: string);
|
|
begin
|
|
if Logger=nil then exit;
|
|
case ALevel of
|
|
mtError: Logger.Error(msg);
|
|
mtWarning: Logger.Warning(msg);
|
|
mtInfo: Logger.Info(msg);
|
|
mtDebug: Logger.Debug(msg);
|
|
{$IFDEF DEBUG} mtExtra: Logger.Log(msg); {$ENDIF}
|
|
end;
|
|
|
|
end;
|
|
|
|
|
|
|
|
begin
|
|
with TMyCGIApp.CreateWithLogger(nil) do
|
|
try
|
|
Initialize;
|
|
Run;
|
|
finally
|
|
Free;
|
|
end;
|
|
end.
|