program oddface_repetidor;

(****
   La ejecución de los demonios de oddface necesitan conectarse a un servidor
central donde está la definición del problema.
   Debido a inconvenientes de conectiviada para alcanzar ese servidor
en el caso del CLUSTER def Facultad, se crea esta aplicación que actúa de REPETIOR.
   Toma las solicitudes de los demonios de una red y las repite contra un servidor
que no es alcanzable por los demonios pero si por la comultadora que ejecuta este servicio.
****)

{$mode objfpc}{$H+}
{$define UseCThreads}

uses {$IFDEF UNIX} {$IFDEF UseCThreads}
  cthreads, {$ENDIF} {$ENDIF}
  baseunix,
  openssl,
  SysUtils,
  Classes,
  xcampos,
  httpdefs,
  uRobotHttpPost,
  fphttpserver,
  fpmimetypes,
  funcsauxs;

type
  { TTestHTTPServer }

  { TSimSEE_HTTPServer }

  TSimSEE_HTTPServer = class(TFPHTTPServer)
  private
    FBaseDir: string;
    FCount: integer;
    FMimeLoaded: boolean;
    FMimeTypesFile: string;
    procedure SetBaseDir(const AValue: string);
  protected
    procedure CheckMimeLoaded;
    property MimeLoaded: boolean read FMimeLoaded;
  public
    xent: TFPHTTPConnectionRequest;
    xsal: TFPHTTPConnectionResponse;

    procedure HandleRequest(var ARequest: TFPHTTPConnectionRequest;
      var AResponse: TFPHTTPConnectionResponse); override;

    procedure wrln(s: string);

    procedure rosx_HandleRequest;

    property BaseDir: string read FBaseDir write SetBaseDir;
    property MimeTypesFile: string read FMimeTypesFile write FMimeTypesFile;


    constructor Create;
    destructor Destroy; override;
  end;

var
  Serv: TSimSEE_HTTPServer;


  { TSimSEE_HTTPServer }

  procedure TSimSEE_HTTPServer.SetBaseDir(const AValue: string);
  begin
    if FBaseDir = AValue then
      exit;
    FBaseDir := AValue;
    if (FBaseDir <> '') then
      FBaseDir := IncludeTrailingPathDelimiter(FBaseDir);
  end;

  procedure TSimSEE_HTTPServer.CheckMimeLoaded;
  begin
    if (not MimeLoaded) and (MimeTypesFile <> '') then
    begin
      MimeTypes.LoadFromFile(MimeTypesFile);
      FMimeLoaded := True;
    end;
  end;

  procedure TSimSEE_HTTPServer.wrln(s: string);
  begin
    xsal.Contents.add(s);
  end;

  procedure TSimSEE_HTTPServer.rosx_HandleRequest;
  var
    s: string;
    k: integer;
    axent: TFPHTTPConnectionRequest;
    af: TUploadedFile;
    farchi: TFileStream;
    j: integer;
    nafectadas: integer;
    aCookie: TCookie;
    NFields: integer;
    rbt: TRobotHttpPost;
    ls: TStringList;
    nombre, valor: string;


    function parseCampo(out nombre, valor: string; const s: string): boolean;
    var
      i: integer;
    begin
      i := strpos(s, '=');
      if i > 0 then
      begin
        nombre := substr(s, 0, i);
        valor := substr(s, i + 1);
        Result := True;
      end
      else
        Result := False;
    end;

  begin

    NFields := xent.FieldCount;
    NFields := xent.ContentFields.Count;


    rbt := TRobotHttpPost.Create('https://iie.fing.edu.uy/~rchaer/ros/rosx.php',
      '', '', False, False);

    for k := 0 to NFields - 1 do
    begin
      s := xent.ContentFields[k];
      if parseCampo(nombre, valor, s) then
        rbt.AddCampo(nombre, valor);
    end;
    for k := 0 to xent.QueryFields.Count - 1 do
    begin
      s := xent.QueryFields[k];
      if parseCampo(nombre, valor, s) then
        rbt.AddCampo(nombre, valor);
    end;

    ls := rbt.post('POST');

    for k := 0 to ls.Count - 1 do
    begin
      s := ls[k];
 //     writeln(s);
      wrln(s);
    end;
    ls.Free;

    rbt.Free;

  end;




  constructor TSimSEE_HTTPServer.Create;
  begin
    inherited Create(nil);
  end;

  destructor TSimSEE_HTTPServer.Destroy;
  begin
    inherited Destroy;
  end;

  procedure TSimSEE_HTTPServer.HandleRequest(var ARequest: TFPHTTPConnectionRequest;
  var AResponse: TFPHTTPConnectionResponse);

  var
    F: TFileStream;
    FN: string;

  begin

    FN := ARequest.Url;
    writeln('Hola, FN: ', FN);

    if pos('rosx.php', FN) > 0 then
    begin
      xent := ARequest;
      xsal := AResponse;
      rosx_HandleRequest;
      AResponse.SendContent;
    end
    else
    begin
      if (length(FN) > 0) and (FN[1] = '/') then
        Delete(FN, 1, 1);
      DoDirSeparators(FN);
      if FN = '' then
        FN := 'index.html';

      FN := BaseDir + FN;
      if FileExists(FN) then
      begin
        F := TFileStream.Create(FN, fmOpenRead);
        try
          CheckMimeLoaded;
          AResponse.ContentType := MimeTypes.GetMimeType(ExtractFileExt(FN));
          Writeln('Serving file: "', Fn, '". Reported Mime type: ',     AResponse.ContentType);
          AResponse.ContentLength := F.Size;
          AResponse.ContentStream := F;
          AResponse.SendContent;
          AResponse.ContentStream := nil;
        finally
          F.Free;
        end;
      end
      else
      begin
        AResponse.Code := 404;
        AResponse.SendContent;
      end;

      Inc(FCount);
      if FCount >= 5 then
        Active := False;

    end;
  end;

{$R *.res}


  procedure main_proc;
  begin
    Serv := TSimSEE_HTTPServer.Create;
    try
      Serv.BaseDir := ExtractFilePath(ParamStr(0)) + 'public_html' +
        DirectorySeparator;
      writeln('basedir: ', Serv.BaseDir);

      Serv.MimeTypesFile := get_SRV_MIME_FILES;
      Serv.Threaded := False;
      Serv.Port := 2281;
      Serv.Active := True;

    finally
      Serv.Free;
    end;
  end;



  function RunAsDaemon: boolean;
  var
    pid: integer;
    status: integer;
  begin
    // init child process
    pid := fpfork();
    Result := pid >= 0;
    if pid = -1 then
      exit;

    if pid = 0 then
    begin
      // in child process - init grandchild
      Close(input);  { close standard in }
      Close(output); { close standard out }
      Assign(output, '/dev/null');
      ReWrite(output);
      Close(stderr); { close standard error }
      Assign(stderr, '/dev/null');
      ReWrite(stderr);
      main_proc;
    end;
    writeln('jeje');
  end;


begin
  if ParamCount = 0 then
    RunAsDaemon
  else
    main_proc;
end.
