LMS-2_ReportAPI/lms_cgi.lpr

program lms_cgi;

{$mode objfpc}{$H+}

uses
  Interfaces,  Classes, SysUtils, inifiles, httpDefs, fpweb, custweb, custcgi,
   lnetbase, tcpClient, tcpthreadhelper, extTypes;

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;
    procedure LoadConfig;
  Protected
   function InitializeWebHandler: TWebHandler; override;
  public
   property Host: string read fHost;
   property Port: integer read fPort;
   property LogFolder: string read fLogFolder;
  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
  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;
  Sender.Terminate;
end;

procedure TMyCGIHandler.HandleRequest(ARequest: Trequest; AResponse: TResponse);
var
  clt: TClientMainThread;
  i: integer;
  k,v: string;
  allfields: TStrings;
begin
  log(mtInfo,self,'Command '+ARequest.Command);
  log(mtInfo,self,'RemoteAddr '+ARequest.RemoteAddr);
  log(mtInfo,self,'RemoteAddress '+ARequest.RemoteAddress);
  log(mtInfo,self,'CommandLine '+ARequest.CommandLine);
  log(mtInfo,self,'ContentRange '+ARequest.ContentRange);
  log(mtInfo,self,'HeaderLine '+ARequest.HeaderLine);
  log(mtInfo,self,'QueryString '+ARequest.QueryString);
  log(mtInfo,self,'Authorization '+ARequest.Authorization);
  log(mtInfo,self,'Connection '+ARequest.Connection);
  log(mtInfo,self,'WWWAuthenticate '+ARequest.WWWAuthenticate);
  log(mtInfo,self,'Content '+ARequest.Content);
  log(mtInfo,self,'ContentType '+ARequest.ContentType);
  log(mtInfo,self,'From '+ARequest.From);
  log(mtInfo,self,'UserAgent '+ARequest.UserAgent);
  log(mtInfo,self,'URI '+ARequest.URI);
  log(mtInfo,self,'URL '+ARequest.URL);
  log(mtInfo,self,'ContentEncoding '+ARequest.ContentEncoding);
  log(mtInfo,self,'ContentLanguage '+ARequest.ContentLanguage);
  log(mtInfo,self,'Query '+ARequest.Query);
  log(mtInfo,self,'Location '+ARequest.Location);
  log(mtInfo,self,'Method '+ARequest.Method);
  log(mtInfo,self,'PathInfo '+ARequest.PathInfo);
  log(mtInfo,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);

  allfields := TStringList.Create;
  try
  allfields.AddStrings(ARequest.QueryFields);
  allfields.AddStrings(ARequest.ContentFields);
  clt := TClientMainThread.Create(ARequest.QueryFields.Values['action'],allfields,@Log,(Owner as TMyCGIApp).Host,(Owner as TMyCGIApp).Port,@answerReady);
  clt.start;
  clt.waitFor;

  finally
     allfields.free;
  end;
  log(mtDebug,self,'Data READY');
  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":[');
      for i := 0 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);
var
  f: TextFile;
  s: string;
begin
  if (Owner as TMyCGIApp).LogFolder='' then exit;
  case ALevel of
    mtError: s := '!!ERROR: ';
    mtWarning: s := '!WARNING: ';
    mtInfo: s := #09;
    mtDebug: s := #09#09;
    mtExtra: s := #09#09#09;
  end;
  assignfile(f, (Owner as TMyCGIApp).LogFolder);
  if fileexists((Owner as TMyCGIApp).LogFolder) then append(f) else rewrite(f);
  writeln(f,s+msg);
  closefile(f);
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;
  Result:=TMyCgiHandler.Create(self);
end;



begin
    with TMyCGIApp.create(nil) do
     try
        Initialize;
        Run;
     finally
        Free;
     end;
end.