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
      if fmODE=3 then
        case fCode of
          ErrorProcessor:  AResponse.Code:=503;
          ErrorLogin:  AResponse.Code:=401;
          ErrorConnect:  AResponse.Code:=401;
          ErrorCommand:  AResponse.Code:=501;
          ErrorComplete:  AResponse.Code:=202;
          ErrorArguments:  AResponse.Code:=400;
          ErrorInternal:  AResponse.Code:=500;
        end
      else
        AResponse.Code:=200;
      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};
  flogger.AppendContent:=true;
  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.