unit ucomunicacionenprogreso;

interface

uses
  {$IFDEF LINUX}
  sockets,
  {$ELSE}
  winsock,
  {$ENDIF}
  {$IFDEF NETTOPOS_DLL}
  uimportnettopos,
  {$ELSE}
  unettopos,
  unettopostypes,
  uglobsharedmem,
  {$ENDIF}
  Classes,
  uordenes,
  SysUtils;

const
  TAM_BUFFERS = 1024 * 64;
  MAX_DATOS_POR_PAQUETE = 64 * 1024;

type
  TBufBytes = packed array[0..1024 * 1024 * 1024] of byte; // solo para typecast
  PBufBytes = ^TBufBytes;


  TPasosComEnProgreso = (SinConexion,
    EscribiendoTopo,
    LeyendoTipoMsg,
    EscribiendoSendMsg,
    LeyendoFC,
    EscribiendoOkFC,
    LeyendoPDatos,
    EscribiendoOkDatos,
    EscribiendoSendMsgConsola,
    LeyendoOrdenConsola,
    EscribiendoRespuestaOrden,
    EsperandoCierreONuevoComunicado);


  TComunicacionEnProgreso = class
  private
    pBuff: PBufBytes; //Puntero al buffer de datos
    NBytes: cardinal; // Tamaño del buffer (para controlar de no pasarse)
    total: cardinal;       // cuántos bytes hemos enviado o recibido en total

    bytesleft: integer;    // cuántos han quedado pendientes
    n: integer;            // Bytes enviados o leidos en el send o recv

    r: ShortString;
    EstadoActual: TPasosComEnProgreso;
    estadoSubCom: integer;

    NBytesPDatos: cardinal;

    iLineaRespuestaOrden: integer;
    respuestaOrden: TStringList;

{$IFDEF SOPORTE_HTTP}
    procedure HTTPConnection;
    // prueba de lectura HTTP/1.1 (por si en algún momento queremos soportar acceso por navegador al topo
{$ENDIF}
    function continuarEscribiendoTopo: integer;
    function continuarLeyendoTipoMsg: integer;
    function continuarEscribiendoSendMsg: integer;
    function continuarLeyendoFC: integer;
    function continuarEscribiendoOkFC: integer;
    function continuarLeyendoPDatos: integer;
    function continuarEscribiendoOkDatos: integer;
    function continuarEscribiendoSendMsgConsola: integer;
    function continuarLeyendoOrdenConsola: integer;
    function continuarEscribiendoRespuestaOrden: integer;

    function procesarOrdenConsola: integer;

    procedure iniciarWriteBytes(xpbuff: PBufBytes; xNBytes: cardinal);
    procedure iniciarWriteln(s: ShortString);
    procedure iniciarReadBytes(xpbuff: PBufBytes; xNBytes: cardinal);
    procedure iniciarReadln;

    function continuarWriteBytes: integer;
    function continuarReadBytes: integer;
    function continuarReadln: integer; //retorna true si termino
  public
    socket: TSocket;
    fc: TFichaComunicado;
    pdatos: PBufBytes;


    constructor Create;
    function empezar(socket: TSocket): integer;

    //Retorna: 0 si hay que seguir leyendo (dar otro continuar)
    //         1 si lo que se leyó se puede procesar
    //         -1 si ocurrió un error
    //         2 si se cierra la conexión correctamente
    function continuar: integer;

    procedure abortar;
    procedure Free;

    procedure CambiarEstado(NuevoEstado: TPasosComEnProgreso);
    function EstadoToStr(estado: TPasosComEnProgreso): string;
  end;

implementation

function TComunicacionEnProgreso.EstadoToStr(estado: TPasosComEnProgreso): string;
begin
  case Estado of
    SinConexion: Result := 'SinConexion';
    EscribiendoTopo: Result := 'EscribiendoTopo';
    LeyendoTipoMsg: Result := 'LeyendoTipoMsg';
    EscribiendoSendMsg: Result := 'EscribiendoSendMsg';
    LeyendoFC: Result := 'LeyendoFC';
    EscribiendoOkFC: Result := 'EscribiendoOkFC';
    LeyendoPDatos: Result := 'LeyendoPDatos';
    EscribiendoOkDatos: Result := 'EscribiendoOkDatos';
    EscribiendoSendMsgConsola: Result := 'EscribiendoSendMsgConsola';
    LeyendoOrdenConsola: Result := 'LeyendoOrdenConsola';
    EscribiendoRespuestaOrden: Result := 'EscribiendoRespuestaOrden';
    EsperandoCierreONuevoComunicado: Result := 'EsperandoCierreONuevoComunicado';
    else
      Result := '???';
  end;
end;


procedure TComunicacionEnProgreso.CambiarEstado(NuevoEstado: TPasosComEnProgreso);
begin
  writeln('CambiarEstado(', socket, ' ', EstadoToStr(EstadoActual),
    ' -> ', EstadoToStr(NuevoEstado), ')');
  EstadoActual := NuevoEstado;
end;

procedure TComunicacionEnProgreso.iniciarWriteBytes(xpbuff: PBufBytes;
  xNBytes: cardinal);
begin
  total := 0;
  bytesleft := xNBytes;
  pBuff := xpbuff;
  NBytes := xNBytes;
end;

procedure TComunicacionEnProgreso.iniciarWriteln(s: ShortString);
begin
  r := s + #13#10;
  iniciarWriteBytes(@r[1], Length(r));
end;

procedure TComunicacionEnProgreso.iniciarReadBytes(xpbuff: PBufBytes; xNBytes: cardinal);
begin
  total := 0;
  bytesleft := xNBytes;
  pBuff := xpbuff;
  NBytes := xNBytes;
end;

procedure TComunicacionEnProgreso.iniciarReadln;
begin
  total := 0;
  pBuff := @r[1];
  NBytes := 255;
  bytesleft := NBytes;
  setlength(r, 0);
end;

function TComunicacionEnProgreso.continuarWriteBytes: integer;
begin
{$IFDEF LINUX}
  n := fpSend(socket, @pBuff^[total], bytesleft, 0);
{$ELSE}
  n := send(socket, pBuff^[total], bytesleft, 0);
{$ENDIF}
  if (n <> -1) and (n <> 0) then
  begin
    total := total + n;
    bytesleft := bytesleft - n;
    if total = NBytes then
      Result := 1
    else
      Result := 0;
  end
  else
    Result := -1;
end;

function TComunicacionEnProgreso.continuarReadBytes: integer;
begin
  //  Writeln('socket= ', socket, ', total= ', total, ', bytesleft= ', bytesleft, ', NBytes= ', NBytes, ', NbytesPDatos= ', NBytesPDatos, ', pbuff= ', integer(pBuff) );
{$IFDEF LINUX}
  n := fpRecv(socket, @pBuff^[total], bytesleft, 0);
{$ELSE}
  n := recv(socket, pBuff^[total], bytesleft, 0);
{$ENDIF}
  if (n <> -1) and (n <> 0) then
  begin
    total := total + n;
    bytesleft := bytesleft - n;
    if total = NBytes then
      Result := 1
    else
      Result := 0;
  end
  else
    Result := -1;
end;

function TComunicacionEnProgreso.continuarReadln: integer;
begin
  {$IFDEF LINUX}
  n := fpRecv(socket, @pBuff^[total], bytesleft, 0);
  {$ELSE}
  n := recv(socket, pBuff^[total], bytesleft, 0);
  {$ENDIF}

  if (n >= 0) then
  begin
    if n > 0 then
    begin
      total := total + n;
      bytesleft := bytesleft - n;
      if      //(r[total - 1] = #13) and
      (r[total] = #10) then
      begin
        Dec(total);
        if (r[total] = #13) then
          Dec(total);
        r[0] := chr(total);
        Result := 1;
      end
      else
        Result := 0;
    end
    else
    begin
      if (total > 0) and
        // (r[total] = #13) and
        (r[total - 1] = #10) then
      begin
        Dec(total);
        if (r[total] = #13) then
          Dec(total);
        r[0] := chr(total);
        Result := 1;
      end
      else
        Result := -1;
    end;
  end
  else
    Result := -1;
end;

constructor TComunicacionEnProgreso.Create;
begin
  inherited Create;
  self.socket := TSocket(-1);
  pdatos := nil;
  cambiarEstado(SinConexion);
end;

function getline(var s: string; var ipos: integer): string;
var
  i1, i2: integer;
  res: string;
  buscando: boolean;

begin
  i1 := ipos;
  i2 := ipos;
  buscando := True;
  while buscando and (i2 < length(s)) do
  begin
    if s[i2] = #10 then
      buscando := False
    else
      Inc(i2);
  end;

  Dec(i2);
  if i2 > i1 then
    if s[i2] = #13 then
      Dec(i2);

  if (buscando) or (i2 = length(s)) then
    ipos := -1 // indicamos que se llegó al fin
  else
    ipos := i2 + 1;
  if i2 > i1 then
    res := copy(s, i1, i2 - i1 + 1);
  Result := res;
end;

{ saca la primer palabra del string s}
function FetchPal(var s: string; sep: string): string;
var
  ipos, n: integer;
  res: string;
begin
  ipos := pos(sep, s);
  if ipos > 0 then
  begin
    res := copy(s, 1, ipos - 1);
    Delete(s, 1, ipos);
  end
  else
  begin
    res := s;
    s := '';
  end;
  Result := res;
end;

{$IFDEF SOPORTE_HTTP}
procedure TComunicacionEnProgreso.HTTPConnection;
var
  timeout: integer;
  s: string;
  method, uri, protocol: string;
  OutputDataString: string;
  ResultCode: integer;
  buff: string;
  res: integer;
  ipos: integer;

begin
  timeout := 120000;
  setlength(buff, 1024 * 10);
  iniciarReadBytes(@buff[1], 1024 * 10);
  repeat
    WriteLn('Received headers+document from browser:');
  until continuarReadBytes <= 0;
  setlength(buff, total);
  writeln(' recibido: ', buff);

  ipos := 1;
  s := getline(buff, ipos);
  method := fetchPal(s, ' ');
  uri := fetchPal(s, ' ');
  protocol := fetchPal(s, ' ');

  writeln('Method: ', method);
  writeln('Uri: ', uri);
  writeln('Protocol: ', protocol);

  (*
  //read request line
  s := ASocket.RecvString(timeout);
  WriteLn(s);
  method := fetch(s, ' ');
  uri := fetch(s, ' ');
  protocol := fetch(s, ' ');


  //read request headers
  repeat
    s := ASocket.RecvString(Timeout);
    WriteLn(s);
  until s = '';

  // Now write the document to the output stream

  if uri = '/' then
  begin
    // Write the output document to the stream
    OutputDataString :=
      '<!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Transitional//EN"'
      + ' "http://www.w3.org/TR/xhtml1/DTD/xhtml1-transitional.dtd">' + CRLF
      + '<html><h1>Teste</h1></html>' + CRLF;

    // Write the headers back to the client
    ASocket.SendString('HTTP/1.0 200' + CRLF);
    ASocket.SendString('Content-type: Text/Html' + CRLF);
    ASocket.SendString('Content-length: ' + IntTostr(Length(OutputDataString)) + CRLF);
    ASocket.SendString('Connection: close' + CRLF);
    ASocket.SendString('Date: ' + Rfc822DateTime(now) + CRLF);
    ASocket.SendString('Server: Servidor do Felipe usando Synapse' + CRLF);
    ASocket.SendString('' + CRLF);

  //  if ASocket.lasterror <> 0 then HandleError;

    // Write the document back to the browser
    ASocket.SendString(OutputDataString);
  end
  else
    ASocket.SendString('HTTP/1.0 404' + CRLF);
    *)
end;

{$ENDIF}



function TComunicacionEnProgreso.empezar(socket: TSocket): integer;
begin
  self.socket := socket;
{$IFDEF SOPORTE_HTTP}
  HTTPConnection;
  //esto está verde, para implementarlo hay que cambiar la lógica de mensajería del topo
  //hay que pasar a "reciba todo lo que venta" y luego interprete
{$ENDIF}
  cambiarEstado(EscribiendoTopo);
  iniciarWriteln('+?topo');
  estadoSubCom := continuarWriteBytes;
  if estadoSubCom = 1 then
  begin
    cambiarEstado(LeyendoTipoMsg);
    iniciarReadln;
    estadoSubCom := 0;
  end;
  Result := estadoSubCom;
end;

function TComunicacionEnProgreso.continuar: integer;
begin
  case EstadoActual of
    EscribiendoTopo: Result := continuarEscribiendoTopo;
    LeyendoTipoMsg: Result := continuarLeyendoTipoMsg;
    EscribiendoSendMsg: Result := continuarEscribiendoSendMsg;
    LeyendoFC: Result := continuarLeyendoFC;
    EscribiendoOkFC: Result := continuarEscribiendoOkFC;
    LeyendoPDatos: Result := continuarLeyendoPDatos;
    EscribiendoOkDatos: Result := continuarEscribiendoOkDatos;
    EscribiendoSendMsgConsola: Result := continuarEscribiendoSendMsgConsola;
    LeyendoOrdenConsola: Result := continuarLeyendoOrdenConsola;
    EscribiendoRespuestaOrden: Result := continuarEscribiendoRespuestaOrden;
    EsperandoCierreONuevoComunicado:
    begin
      {$IFDEF LINUX}
      n := fpRecv(socket, @r[1], 255, 0);
      {$ELSE}
      n := recv(socket, r[1], 255, 0);
      {$ENDIF}
      if n = 0 then
      begin
        cambiarEstado(SinConexion);
        Result := 2;
      end
      else if n = -1 then
      begin
        cambiarEstado(SinConexion);
        Result := -1;
      end
      else
      begin
        r[0] := chr(n);
        if  pos('+MsgAsn', r ) = 1 then
        begin
          cambiarEstado(EscribiendoSendMsg);
          iniciarWriteln('+send_MsgAsn');
          estadoSubCom := continuar;
          Result := estadoSubCom;
        end
        else
        begin
          if ( pos( '+mc', r ) = 1 ) then
          begin // modo rápido para mensajes de consola
            Delete(r, 1, 4);
            r:= trim( r );
            r := '+' + r + '-';
            result:= procesarOrdenConsola;
          end
          else
          begin
          cambiarEstado(LeyendoTipoMsg);
          iniciarReadln;
          total := n;
          estadoSubCom := 0;
          Result := estadoSubCom;
          end;
        end;
      end;
    end;
    else
      raise Exception.Create(
        'TComunicacionEnProgreso.continuar: me dieron continuar en el estado SinConexion');
  end;
end;

procedure TComunicacionEnProgreso.abortar;
begin
  estadoSubCom := 0;
  cambiarEstado(SinConexion);
  self.socket := TSocket(-1);
end;

procedure TComunicacionEnProgreso.Free;
begin
  if pdatos <> nil then
    FreeMem(pdatos, NBytesPDatos);
  inherited Free;
end;

function TComunicacionEnProgreso.continuarEscribiendoTopo: integer;
begin
  estadoSubCom := continuarWriteBytes;
  if estadoSubCom = 1 then
  begin
    cambiarEstado(LeyendoTipoMsg);
    iniciarReadln;
    estadoSubCom := 0;
  end;
  Result := estadoSubCom;
end;

function TComunicacionEnProgreso.continuarLeyendoTipoMsg: integer;
begin
  estadoSubCom := continuarReadln;
  if estadoSubCom = 1 then
  begin
    if r = '+MsgAsn' then
    begin
      cambiarEstado(EscribiendoSendMsg);
      iniciarWriteln('+send_MsgAsn');
      estadoSubCom := continuar;
    end
    else if r = '+MsgConsola' then
    begin
      CambiarEstado(EscribiendoSendMsgConsola);
      iniciarWriteln('+send_MsgConsola');
      estadoSubCom := continuar;
    end
    else if pos('+mc ', r) = 1 then
    begin // modo rápido para mensajes de consola
      Delete(r, 1, 4);
      r := '+' + r + '-';
      procesarOrdenConsola;
    end
    else
    begin
      logError('TComunicacionEnProgreso.continuarLeyendoTipoMsg: tipoMsg desconocido '
        + r);
      iniciarReadln;
      estadoSubCom := 0;
    end;
  end;
  Result := estadoSubCom;
end;

function TComunicacionEnProgreso.continuarEscribiendoSendMsg: integer;
begin
  estadoSubCom := continuarWriteBytes;
  if estadoSubCom = 1 then
  begin
    cambiarEstado(LeyendoFC);
    iniciarReadBytes(@fc, SizeOf(fc));
    estadoSubCom := 0;
  end;
  Result := estadoSubCom;
end;

function TComunicacionEnProgreso.continuarLeyendoFC: integer;
begin
  estadoSubCom := continuarReadBytes;
  if estadoSubCom = 1 then
  begin
    cambiarEstado(EscribiendoOkFC);
    iniciarWriteln('+OkFC');
    estadoSubCom := continuar;
  end;
  Result := estadoSubCom;
end;

function TComunicacionEnProgreso.continuarEscribiendoOkFC: integer;
begin
  estadoSubCom := continuarWriteBytes;
  if estadoSubCom = 1 then
  begin
    if fc.nBytesDatos > 0 then
    begin
      if NBytesPDatos < fc.nBytesDatos then
      begin
        if pdatos <> nil then
          FreeMem(pdatos, NBytesPDatos);
        NBytesPDatos := fc.nBytesDatos;
        GetMem(pdatos, NBytesPDatos);
      end;
      cambiarEstado(LeyendoPDatos);
      iniciarReadBytes(pdatos, fc.nBytesDatos);
      estadoSubCom := 0;
    end
    else
      cambiarEstado(EsperandoCierreONuevoComunicado);
  end;
  Result := estadoSubCom;
end;

function TComunicacionEnProgreso.continuarLeyendoPDatos: integer;
begin
  estadoSubCom := continuarReadBytes;
  if estadoSubCom = 1 then
  begin
    cambiarEstado(EscribiendoOkDatos);
    iniciarWriteln('+OkDatos');
    estadoSubCom := continuar;
  end;
  Result := estadoSubCom;
end;

function TComunicacionEnProgreso.continuarEscribiendoOkDatos: integer;
begin
  estadoSubCom := continuarWriteBytes;
  if estadoSubCom = 1 then
    cambiarEstado(EsperandoCierreONuevoComunicado);
  Result := estadoSubCom;
end;

function TComunicacionEnProgreso.continuarEscribiendoSendMsgConsola: integer;
begin
  estadoSubCom := continuarWriteBytes;
  if estadoSubCom = 1 then
  begin
    cambiarEstado(LeyendoOrdenConsola);
    iniciarReadln;
    estadoSubCom := 0;
  end;
  Result := estadoSubCom;
end;


function TComunicacionEnProgreso.procesarOrdenConsola: integer;
begin
  respuestaOrden := uOrdenes.interpretarOrden(r);
  cambiarEstado(EscribiendoRespuestaOrden);
  iLineaRespuestaOrden := 0;
  iniciarWriteln(respuestaOrden[iLineaRespuestaOrden]);
  estadoSubCom := continuar;
  Result := estadoSubCom;
end;


function TComunicacionEnProgreso.continuarLeyendoOrdenConsola: integer;
begin
  estadoSubCom := continuarReadln;
  if estadoSubCom = 1 then
  begin
    respuestaOrden := uOrdenes.interpretarOrden(r);
    cambiarEstado(EscribiendoRespuestaOrden);
    iLineaRespuestaOrden := 0;
    iniciarWriteln(respuestaOrden[iLineaRespuestaOrden]);
    estadoSubCom := continuar;
  end;
  Result := estadoSubCom;
end;

function TComunicacionEnProgreso.continuarEscribiendoRespuestaOrden: integer;
begin
  estadoSubCom := continuarWriteBytes;
  if estadoSubCom = 1 then
  begin
    while (iLineaRespuestaOrden < respuestaOrden.Count - 1) and (estadoSubCom = 1) do
    begin
      iLineaRespuestaOrden := iLineaRespuestaOrden + 1;
      iniciarWriteln(respuestaOrden[iLineaRespuestaOrden]);
      estadoSubCom := continuarWriteBytes;
    end;
    if iLineaRespuestaOrden = respuestaOrden.Count - 1 then
    begin
      iLineaRespuestaOrden := 0;
      respuestaOrden.Free;
      cambiarEstado(EsperandoCierreONuevoComunicado);
    end;
  end;
  Result := estadoSubCom;
end;

end.
