unit unettopos;

{$IFDEF FPC}
  {$MODE Delphi}
{$ENDIF}

interface

uses
{$IFDEF LINUX}
  ERRORS,
  sockets,
  baseunix,
  uKeyDir,
  uEmuladorWinIPC,
  uWinMsgs,
{$ELSE}
  Windows,
  WinSock,
  ipcthrd in '..\fctopos\IPC\Win32\ipcthrd.pas',
{$ENDIF}
  Classes,
  SysUtils,
  uconstantes_nettopos,
  uglobsharedmem,
{$IFDEF HEAPMANAGER}
  uHeapManager,
{$ENDIF}
  usockettimedconnect,
  urosx,
  unettopostypes,
  ubuffrw,
  xmatdefs;



(*+doc Cualquier alplicación que quiera utilizar la nettopos debe llamar
esta función antes que nada. Luego debe llamar registrarAplicacion para
ser candidata a recibir mensajes.
Si estamos en windows, se inicializa la libreria winsock por lo que no se debe
inicializar por parte de la aplicación.
-doc*)
function inicializar:Boolean; stdcall;


(*+doc Registra una aplicacion con el nombre y handle especificados y devuelve su
número de identificador. El nombre debe ser único entre las aplicaciones de
la libreria.
En caso de error retorna 0 (Cero).
Si la función tiene éxito retorna el valor idAplic.
El idAplic debe ser el HANDLE de la aplicación en el sistema de mensajería del
sistema Operativo. En WIN32, ese valor es directamente el "handle" de la ventana
principal de la aplicación.
Para las aplicaciones de Linux, esta llamada a registrarAplicacion tiene el efecto
colateral de inscribir la aplicación en un "administrador de cola de mensajerias"
que emula el sistema de mensajería usado en Win32. En este caso el valor idAplic
debe ser el PID del proceso principal.

En caso de error, usar la función "getUltimoError" para obtener el código
de error correspondiente.

-doc*)
function registrarAplicacion(nombreAplic: PChar; idAplic: cardinal): cardinal; stdcall;


(* Libera los recursos asignados a la aplicacion identificada por su nombre
   a partir de esta llamada, la aplicación deja de ser candidata a recibir
   mensajes.
   Retorna el idAplic en caso de haber podido desresgistrar exitosamente la
   aplicación y 0 (cero) en caso contrario.

   En caso de error, usar la función "getUltimoError" para obtener el código
   de error correspondiente.
   *)
function desregistrarAplicacion(idAplic: cardinal): cardinal; stdcall;

(* Libera los recursos de la librería asignados a la aplicación.
  debe ser la última llamada de la aplicación a la librería *)
procedure finalizar; stdcall;


//Retorna el identificador asociado a nombreAplic en el nodo especificado.
//Si no se encuentra una aplicación con ese nombre retorna -1
// El parámetro idNodo identifica el Nodo en el que se debe buscar la apicación.
// Si es cero o el id del topo, la búsqueda es en el nodo LOCAL sino se envía la consulta
// mediante un comunicarTS al topo Remoto del nodo idNodo.
function getIdAplicacion(idNodo: cardinal; nombreAplic: PChar): cardinal; stdcall;

// retorna el nombre de la aplicación "idAplic" en el nodo "idNodo"

function getNombreAplicacion(idNodo: cardinal;
  idAplic: cardinal): ShortString; stdcall;

(*+doc
Retorna el nombre del nodo local. El nombre del nodo local es el nombre de la MAQUINA
especificado en la red.
-doc*)
function getNombreNodoLocal: shortstring; stdcall;

(*+doc
Retorna el identificador del nodo local. Las aplicaciones no necesitan
conocer el Id del nodo local, pueden usar 0 (cero) como identificador
del nodo local en las llamadas a las funciones.
-doc*)
function getIdNodoLocal: cardinal; stdcall;


(*+doc
Envia un comunicado a la aplicación destino en el nodo destino
Si el idNodoDestino es 0 o es igual al id del nodo local
el mensaje se distribuye localmente.
Si el idNodoDestino <> 0 y no es el id del local, el mensaje
se transmite por la red al nodo idNodoDestino para su ditribución.
El resultado es 0 (si falló al enviar el comunicado) y >0 si logró enviarlo.
Si es > 0 es el idPeticion (puede servir para debug. el usuario no necesita hacer uso de este número sólo le importa si es 0 o no )

El tiempo de timeOutCOm_ms es el de cada intento de comunicación.
La cantidad de intentos es una constante global definida en uconstantes_nettopos.
*)
function comunicar(pfc: PFichaComunicado; pdatos: pointer;
  timeOutCom_ms: integer): cardinal; stdcall;


(*+doc
Esta función debe ser usada por las aplicaciones para leer los datos
asociados a un comunicado.
Tanto cuando una aplicacion recibe un mensaje de comunicado en forma asincrona
o cuando sale de una llamada a comunicarTS, la aplicación dispone del
identificador del comunicado y debe llamar esta funcion para leer la ficha
del comunicado. Luego de leer la ficha debe llamar a levantarDatos
para terminar de leer el comunicado.
El parametro pfc debe apuntar a un area de memoria donde la funcion
copiara la  ficha del comunicado.
Si se produce un error el resultado es CERO sino retorna el idComunicado.
-doc*)
function leerFichaComunicado(idComunicado: cardinal;
  pfc: PFichaComunicado): cardinal; stdcall;

(*doc
Levanta el comunicado y libera la ficha de petición asociada.
El el caso en que el comunicado tenga datos asociados y que se pase
un puntero pdatos <> nil, se copian de la ficha de petición la cantidad
de nbytes (o la cantidad de datos almacenados en la ficha de pteción, lo que sea menor)
datos en la posición de memoria apuntada por pdatos.
Si no interesan los datos simplemente poner pdatos = nil.
*)
function levantarDatosComunicado(idComunicado: cardinal; pdatos: pointer;
  nbytes: cardinal): cardinal; stdcall;


function getUltimoError: integer; stdcall;
procedure setUltimoError(codigoError: integer); stdcall;


(*+doc
Envia un comunicado en forma de Tarea Sincrona. El comunicado es enviado,
y la función no retorna hasta que se recibe la respuesta o hasta que
halla transcurrido el tiempo timeout expresado en milisegundos.
El resultado de esta función es el identificador del comunicado de
respuesta para que se puedan leer los datos y levantar el comunicado.
-doc*)
function comunicarTS(pfc: PFichaComunicado; pdatos: pointer;
  timeout_ms: integer): cardinal; stdcall;

(*+doc
Esta función es para uso exclusivo de la aplicación Topo y lo que hace
es notificar la respuesta a un proceso que ha quedado esperándo luego
de llamar a comunicarTS.
-doc*)
function respuestaTS(idPeticion, idTarea: cardinal; pfc: PFichaComunicado;
  pdatos: pointer): cardinal; stdcall;


(* Estas funciones son auxiliares para debug.
Incrementan y decrementan el contador pm^CntDBG  y escriben en valor
en pantalla con un writeln( pm^CntDBG )
Para manejar el contador usan semáforo por lo que son funciones seguras
para multi-proceso.
*)
procedure incCntDBG; stdcall;
procedure decCntDBG; stdcall;


(* Funciones auxilares para pasar de direcciones IP en formato Cardinal
a formato string y viceversa *)
function CardinalToIP4Str(AIpValue: cardinal): shortstring; stdcall;
function IP4StrToCardinal(const AIpAddress: shortstring): cardinal; stdcall;



procedure PrepararFCRespuesta(var fr: TFichaComunicado; fc: TFichaComunicado;
  codigoMsg: integer; nBytesDatos: cardinal); stdcall;


{$IFDEF LINUX}

(* Estas funciones son para emular el manejo de mensajes de windows para las aplicaciones
esto permite crear aplicaciones como en Windows, que postean mensajes y reciben mensajes. *)
function xGetMessage_WAIT(var m: TWinMsg): integer; stdcall;
function xGetMessage_NOWAIT(var m: TWinMsg): integer; stdcall;
function xPostMessage(idDestino: integer; msgCode: cardinal;
  wParam: word; lParam: longint): integer; stdcall;

{$ENDIF}


(* Esta función es de bajo nivel y debería no utilizarse. Está en la interfase para facilitar
su uso por el Topo. *)
function cliOpen(var sock: TSocket; hostId: cardinal; port: integer;
  timeOutCom_ms: cardinal): boolean;

(*
*)
function comunicar_retardado(pfc: PFichaComunicado; pdatos: pointer;
  timeOutCom_ms: integer; nSecs: integer): cardinal; stdcall;



function getNodosRegistrados: TDArrOfNodos;


implementation

var
  listaConexiones: TList;




procedure sxc(var a, b: cardinal);
var
  z: cardinal;
begin
  z := a;
  a := b;
  b := z;
end;

procedure PrepararFCRespuesta(var fr: TFichaComunicado; fc: TFichaComunicado;
  codigoMsg: integer; nBytesDatos: cardinal);
begin
  fr := fc;
  sxc(fr.idNodoOrigen, fr.idNodoDestino);
  sxc(fr.idOrigen, fr.idDestino);
  fr.codigoMsg := codigoMsg;
  fr.nBytesDatos := nBytesDatos;
  fr.idTarea := fc.idTarea;
end;

procedure incCntDBG;
var
  smf_CntDBG: TMutex;
begin
{$IFDEF LINUX}
  smf_CntDBG := TMutex.Create(keySmfCntDBG, 1);
{$ELSE}
  smf_CntDBG := TMutex.Create(nom_Smf_CntDBG);
{$ENDIF}
  smf_CntDBG.Get(1000);
  pm^.CntDBG := pm^.CntDBG + 1;
  writeln(pm^.CntDBG);
  smf_CntDBG.Release;
  smf_CntDBG.Free;
end;

procedure decCntDBG;
var
  smf_CntDBG: TMutex;
begin
{$IFDEF LINUX}
  smf_CntDBG := TMutex.Create(keySmfCntDBG, 1);
{$ELSE}
  smf_CntDBG := TMutex.Create(nom_Smf_CntDBG);
{$ENDIF}
  smf_CntDBG.Get(1000);
  pm^.CntDBG := pm^.CntDBG - 1;
  writeln(pm^.CntDBG);
  smf_CntDBG.Release;
  smf_CntDBG.Free;
end;

function CardinalToIP4Str(AIpValue: cardinal): shortstring;
var
  Retvar: string;
  iSeg, xIP, i: longword;
begin
  Retvar := '';
  xIP := AIpValue;
  for i := 1 to 4 do
  begin
    iSeg := (xIP and $FF);
    Retvar := IntToStr(iSeg) + Retvar;
    if i <> 4 then
      Retvar := '.' + Retvar;
    xIP := xIP shr 8;
  end;
  Result := Retvar;
end;

function getUltimoError: integer; stdcall;
begin
  Result := UltimoError_x;
end;

procedure setUltimoError(codigoError: integer); stdcall;
begin
  UltimoError_x := codigoError;
  logError('CodigoError: ' + IntToStr(UltimoError_x) + ' ErrStr:' +
    getNetTopos_StrError(CodigoError));
end;

function NextNIDPeticionVal: cardinal;
var
  smf: TMutex;
begin
{$IFDEF LINUX}
  smf := TMutex.Create(keySmfNextNIDPeticion, 1);
{$ELSE}
  smf := TMutex.Create(nom_Smf_NextNIDPeticion);
{$ENDIF}

  if not smf.get(12000) then
  begin
    logError('unettopos.NextNIDPeticionVal: Error no consegui semaforo');
    setUltimoError(ERROR_NoConseguiSemaforo);
    Result := 0;
    smf.Free;
    exit;
  end;

  Result := pm^.NextNIDPeticion;
  pm^.NextNIDPeticion := pm^.NextNIDPeticion + 1;
{$IFDEF NID_PETICION_CON_PERMANENCIA}
  Assign(f, ARCHI_NEXT_NID_PETICION);
  rewrite(f);
  writeln(f, IntToStr(pm^.NextNIDPeticion));
  Close(f);
{$ENDIF}
  smf.Release;
  smf.Free;

end;


procedure readInitNextNIDPeticion;
var
  smf: TMutex;
begin
{$IFDEF LINUX}
  smf := TMutex.Create(keySmfNextNIDPeticion, 1);
{$ELSE}
  smf := TMutex.Create(nom_Smf_NextNIDPeticion);
{$ENDIF}
  if smf.get(6000) then
  begin
{$IFDEF NID_PETICION_CON_PERMANENCIA}
    Assign(f, ARCHI_NEXT_NID_PETICION);
    {$I-}
    reset(f);
    {$I+}
    if ioresult = 0 then
      readln(f, pm^.NextNIDPeticion)
    else
    begin
      rewrite(f);
      pm^.NextNIDPeticion := 1;
      writeln(f, pm^.NextNIDPeticion);
    end;
    Close(f);
{$ELSE}
    pm^.NextNIDPeticion := 1;
{$ENDIF}
    smf.Release;
  end;
  smf.Free;
end;

function IP4StrToCardinal(const AIpAddress: shortstring): cardinal; stdcall;
var
  Retvar, i: longword;
  sData, sSeg: string;
begin
  Retvar := 0;
  sData := trim(AIpAddress);
  while sData <> '' do
  begin
    Retvar := Retvar shl 8;
    i := pos('.', sData);
    if i <> 0 then
    begin
      sSeg := copy(sData, 1, i - 1);
      sData := copy(sData, i + 1, length(sData));
    end
    else
    begin
      sSeg := sData;
      sData := '';
    end;
    Retvar := Retvar + (longword(StrToIntDef(sSeg, 0)));
  end;
  Result := Retvar;
end;

(*+doc
Retorna el identificador del nodo local. Las aplicaciones no necesitan
conocer el Id del nodo local, pueden usar 0 (cero) como identificador
del nodo local en las llamadas a las funciones.
-doc*)
function getIdNodoLocal: cardinal; stdcall;
begin
  Result := pm^.idNodoLocal;
end;

(*+doc
Retorna el nombre del nodo local
-doc*)
function getNombreNodoLocal: shortstring; stdcall;
begin
  Result := pm^.nombreMaquina;
end;

procedure InicializarValoresSharedMem; stdcall;
var
  k: integer;
  f: TextFile;
  path_ARCHI_DBGLOG, path_ARCHI_ERRLOG: string;
begin
  writeln('->unettopos.InicializarValoresSharedMem77');
  pm^.idTopoLocal := 0;
  pm^.CntDBG := 0;

  pm^.nombreMaquina := '?';
  pm^.idNodoLocal := 0;

  //Creo los directorios del archivo de logs
  path_ARCHI_DBGLOG := ExtractFilePath(ARCHI_DBGLOG);
  if (path_ARCHI_DBGLOG <> '') and (not DirectoryExists(path_ARCHI_DBGLOG)) then
    ForceDirectories(path_ARCHI_DBGLOG);

  path_ARCHI_ERRLOG := ExtractFilePath(ARCHI_ERRLOG);
  if (path_ARCHI_ERRLOG <> '') and not DirectoryExists(path_ARCHI_ERRLOG) then
    ForceDirectories(path_ARCHI_ERRLOG);

  writeln('Creando archivo de DBGLOG: ' + ARCHI_DBGLOG);
  AssignFile(f, ARCHI_DBGLOG);
  Rewrite(f);
  CloseFile(f);

  writeln('Creando archivo de ERRLOG: ' + ARCHI_ERRLOG);
  AssignFile(f, ARCHI_ERRLOG);
  Rewrite(f);
  CloseFile(f);

{$IFDEF DBGLOG}
  dbglog('***********************************');
  dbglog('INICIALIZANDO ... valores ShareMem ...');
{$ENDIF}

  writeln('for aplics ');
  for k := 1 to MAX_N_APLICACIONES do
  begin
    with uglobsharedmem.pm^.aplicacionesLocales[k] do
    begin
      nombreAplic := '';
      idAplic := 0;
    end;
  end;

  writeln(' for pets ');
  for k := 1 to MAX_N_PETICIONES do
  begin
    with uglobsharedmem.pm^.peticiones[k] do
    begin
      idPeticion := 0;
      dtInicio := now();
      dtVencimiento := dtInicio + DEF_TIMEOUT_DT;
    end;
  end;

  writeln(' pm^ ');
  pm^.nextIdTareaSincrona := 1;

  writeln(' for tsincro ');
  for k := 1 to MAX_N_TAREAS_SINCRONAS do
  begin
    uglobsharedmem.pm^.tareasSincronas[k].idPeticion := 0;
  end;

  {$IFDEF HEAPMANAGER}
  writeln(' ... inicializarHeap ');
  uHeapManager.inicializarHeap(@pm^.heapRec);
  {$ENDIF}

  writeln('voy nextnidpet...');
  readInitNextNIDPeticion;

  writeln('unettopos.InicializarValoresSharedMem->');
end;

{*************************************************************** }

//Registra una aplicacion con el nombre y handle especificados y devuelve su
//número de identificador. El nombre debe ser único entre las aplicaciones de
//la libreria
//En caso de error retorna 0
function registrarAplicacion(nombreAplic: PChar; idAplic: cardinal): cardinal; stdcall;
var
  smf: TMutex;
  res: cardinal;
  pApl: PFichaAplicacion;
label
  lbl_fin1, lbl_fin2, lbl_fin3;
begin
  // si viene un handle nulo ERROR
  if idAplic = 0 then
  begin
    SetUltimoError(ERROR_idAplicacionNulo);
    res := 0;
    goto lbl_fin3;
  end;

  // si no logro el semáforo ERROR
{$IFDEF LINUX}
  smf := TMutex.Create(keySmfAplics, 1);
{$ELSE}
  smf := TMutex.Create(nom_Smf_Aplics);
{$ENDIF}

  writeln('voy smf_get');
  if not smf.Get(600) then
  begin
    setUltimoError(ERROR_NoConseguiSemaforo);
    res := 0;
    goto lbl_fin2;
  end;

  writeln('voy a getAplicIdByName');
  // si ya está registrada ERROR
  res := getAplicIdByName(nombreAplic);
  if res > 0 then
  begin
    setUltimoError(ERROR_NombreAplicacionRepetido);
    res := 0;
    goto lbl_fin1;
  end;

  writeln('voy a getPrimerFichasAplicacionLibre');
  // busco primer ficha de aplicación libre si no la encuentro error
  pApl := getPrimerFichaAplicacionLibre;
  if pApl = nil then
  begin
    setUltimoError(ERROR_NoHayAplicacionesLibres);
    res := 0;
    goto lbl_fin1;
  end;


  writeln('NombreAplic: ', NombreAplic);
  if (NombreAplic = AppName_Topo) then
    pm^.idTopoLocal := idAplic;

  idAplicYo := idAplic;
  pApl^.idAplic := idAplic;
  pApl^.nombreAplic := nombreAplic;
  res := pApl^.idAplic;

{$IFDEF LINUX}
  writeln(' Creando Cola de mensajes para el receptor: ', idAplic);
  ColaDeMensajes := TColaDeMensajes.Create(idAplic);
  writeln(' Volvi de crear la cola de mensajes ');
  ColaDeMensajes.Clear;
  writeln('Volvi del clear');
{$ENDIF}

{$IFDEF HEAPMANAGER}
  writeln('voy a THeapManager.Create...');
  heapManager := THeapManager.Create(@pm^.heapRec, @pm^.heapBuff);
{$ENDIF}

  lbl_fin1:
    writeln('lbl_fin1');
  smf.Release;

  lbl_fin2:
    writeln('lbl_fin2');
  smf.Free;

  lbl_fin3:
    writeln('lbl_fin3');
  Result := res;
{$IFDEF DBGLOG}
  dbglog('registrarAplicacion res:' + IntToStr(res) + '::');
{$ENDIF}
end;




//Libera los recursos asignados a la aplicacion identificada por su nombre
function desregistrarAplicacion(idAplic: cardinal): cardinal; stdcall;
var
  smf: TMutex;
  pAplic: pFichaAplicacion;
begin
{$IFDEF DBGLOG}
  dbglog('desregistrarAplicacion');
{$ENDIF}

{$IFDEF LINUX}
  ColaDeMensajes.Free;
  smf := TMutex.Create(keySmfAplics, 1);
{$ELSE}
  smf := TMutex.Create(nom_Smf_Aplics);
{$ENDIF}
  if not smf.Get(600) then
  begin
    setUltimoError(ERROR_NoConseguiSemaforo);
    smf.Free;
    Result := 0;
    exit;
  end;

  if idAplicYo <> idAplic then
  begin
    setUltimoError(ERROR_IntentoDeDesregistrarOtraAplicacion);
    smf.Release;
    smf.Free;
    Result := 0;
    exit;
  end;

  pAplic := GetAplicById(idAplic);
  if pAplic = nil then
  begin
    setUltimoError(ERROR_idAplicacion_NoEncontrado);
    smf.Release;
    smf.Free;
    Result := 0;
    exit;
  end;

  if pm^.idTopoLocal = idAplic then
  begin
    pm^.idTopoLocal := 0;
  end;
  idAplicYo := 0;
  pAplic^.idAplic := 0;
  {$IFDEF HEAPMANAGER}
  heapManager.Free;
  {$ENDIF}
  Result := idAplic;
  smf.Release;
  smf.Free;
end;

{$IFDEF LINUX}
function WSAGetLastError: integer;
begin
  Result := SocketError;
end;

{$ENDIF}




function cliOpen(var sock: TSocket; hostId: cardinal; port: integer;
  timeOutCom_ms: cardinal): boolean;
var
  addr: sockaddr_in;
  k: integer;
  timeOut: TimeVal;
  chuco: Boolean;
begin
  addr.sin_family := PF_INET;
  addr.sin_port := htons(port); // ShortHostToNet(port);
  addr.sin_addr.S_addr := longint((htonl(longint(hostId))));//HostTonet(longint(h.IPAddress));


  for k := 0 to 7 do
{$IFDEF LINUX}
    addr.xpad[k] := chr(0);
  sock := fpSocket(PF_INET, SOCK_STREAM, 0);
{$ELSE}
  addr.sin_zero[k] := chr(0);
  sock := Socket(PF_INET, SOCK_STREAM, 0);
{$ENDIF}

{$IFDEF LINUX}
  if sock = -1 then
  begin
    logError('cliOpen: Error creando socket, WSAGetLastError= ' +
      strerror(WSAGetLastError));
    Result := False;
    exit;
  end;
{$ELSE}
  if WSAGetLastError <> 0 then
  begin
    logError('cliOpen: Error creando socket, WSAGetLastError= ' +
      IntToStr(WSAGetLastError));
    Result := False;
    exit;
  end;
{$ENDIF}


  if timeOutCom_ms <> 0 then
  begin
    timeOut.tv_sec := timeOutCom_ms div 1000;
    timeOut.tv_usec := 0;
    //          if setsocketoptions( sock, SOL_SOCKET, SO_RCVTIMEO, timeOut, SizeOf(timeOut)) <> 0 then
{$IFDEF LINUX}
    if fpsetsockopt(sock, SOL_SOCKET, SO_RCVTIMEO, @timeOut,
      SizeOf(timeOut)) <> 0 then
{$ELSE}
      if setsockopt(sock, SOL_SOCKET, SO_RCVTIMEO, @timeOut, SizeOf(timeOut)) <> 0 then
{$ENDIF}
      begin
        logError('cliOpen: Error fijando timeOut de lectura, WSAGetLastError= ' +
          IntToStr(WSAGetLastError));
        closesocket(sock);
        Result := False;
        Exit;
      end;

    //          if setsocketoptions(topotx, SOL_SOCKET, SO_SNDTIMEO, timeOut, SizeOf(timeOut)) <> 0 then
{$IFDEF LINUX}
    if fpsetsockopt(sock, SOL_SOCKET, SO_SNDTIMEO, @timeOut,
      SizeOf(timeOut)) <> 0 then
{$ELSE}
      if setsockopt(sock, SOL_SOCKET, SO_SNDTIMEO, @timeOut, SizeOf(timeOut)) <> 0 then
{$ENDIF}
      begin
        logError('cliOpen: Error fijando timeOut de escritura, WSAGetLastError= ' +
          IntToStr(WSAGetLastError));
        closesocket(sock);
        Result := False;
        Exit;
      end;

    // chancheo un poco el connect para meterle el timeout
    if not socketTimedConnect(sock, TSockAddr(addr), sizeOf(
      addr), timeoutCom_ms) then
    begin
      logError('cliOpen: Error conectando socket, WSAGetLastError= ' +
        IntToStr(WSAGetLastError) + ', socket= ' + IntToStr(sock));
      closesocket(sock);
      Result := False;
      Exit;
    end;
  end
  else
  begin
    // connect sin timeout
    {$IFDEF LINUX}
    if not fpConnect(sock, @addr, sizeOf(addr)) <> 0 then
    {$ELSE}
      if Connect(sock, addr, sizeOf(addr)) <> 0 then
    {$ENDIF}
      begin
        logError('cliOpen: Error conectando socket, WSAGetLastError= ' +
          IntToStr(WSAGetLastError) + ', socket= ' + IntToStr(sock));
        closesocket(sock);
        Result := False;
        Exit;
      end;
  end;
  Result := True;
end;

function comunicar_retardado(pfc: PFichaComunicado; pdatos: pointer;
  timeOutCom_ms: integer; nSecs: integer): cardinal; stdcall;
var
  fcr: TFichaComunicado;
  p: array of byte;

begin

  //en principio el servidor de mensajes retardados es el topo local
  //esto se podra modificar enviando este mensaje a otro topo
  fcr.idNodoOrigen := pm^.idNodoLocal;
  fcr.idOrigen := idAplicYo;
  fcr.idNodoDestino := pm^.idNodoLocal;
  fcr.idDestino := pm^.idTopoLocal;


  fcr.nBytesDatos := pfc^.nBytesDatos + SizeOf(TFichaComunicado);
  fcr.codigoMsg := MSGP_MensajeRetardado;

  SetLength(p, fcr.nBytesDatos);
  Move(pfc, p[0], SizeOf(TFichaComunicado) - 1);
  if pdatos <> nil then
    Move(pdatos, p[SizeOf(TFichaComunicado)], pfc^.nBytesDatos);

  comunicar(@fcr, @p[0], timeOutCom_ms);

end;

function getNodosRegistrados: TDArrOfNodos;
var

  fc_s, fc_e: TFichaComunicado;
  idComunicado: cardinal;
  dato: TBuffReader;
  nodos: TDAofNCardinal;
  nombres: TStringList;
  i: integer;

  lstNodos: TDArrOfNodos;

begin

  fc_s.idNodoOrigen := getIdNodoLocal;
  fc_s.idOrigen := idAplicYo;
  fc_s.idNodoDestino := getIdNodoLocal;
  fc_s.idDestino := pm^.idTopoLocal;
  fc_s.codigoMsg := MSGP_GETNODOS;
  fc_s.nBytesDatos := 0;

  idcomunicado := comunicarTS(@fc_s, nil, 15000);

  if idcomunicado > 0 then
  begin
    if leerFichaComunicado(idComunicado, @fc_e) > 0 then
    begin
      if fc_e.nBytesDatos > 0 then
      begin
        dato := TBuffReader.Create(fc_e.pdatos, fc_e.nBytesDatos);
        dato.xTDAOfCardinal(nodos);
        dato.xStringList(nombres);
        levantarDatosComunicado(idComunicado, nil, 0);
        SetLength(lstNodos, nombres.Count);
        for i := 0 to nombres.Count - 1 do
          lstNodos[i] := TNodo.Create(CardinalToIP4Str(nodos[i]),
            nodos[i + 1], nombres.Strings[i]);

        Result := lstNodos;
      end
      else
        raise Exception.Create('unettopos.getNodosRegistrados: Com vacio');
    end
    else
      raise Exception.Create('unettopos.getNodosRegistrados: No se pudo leer fichaCom');
  end
  else
    raise Exception.Create('unettopos.getNodosRegistrados: Fallo Com');
end;

function cliSendAll(s: TSocket; var Buf; len: integer): boolean;
var
  total: integer;        // cuántos bytes hemos enviado
  bytesleft: integer; // cuántos se han quedado pendientes
  n: integer;
begin
  total := 0;
  bytesleft := len;

  while (total < len) do
  begin
{$IFDEF LINUX}
    n := fpSend(s, @TLArrOfBytes(buf)[total], bytesleft, 0);
{$ELSE}
    n := send(s, TLArrOfBytes(buf)[total], bytesleft, 0);
{$ENDIF}
    if (n = -1) then
      break;
    total := total + n;
    bytesleft := bytesleft - n;
  end;
  Result := len = total;
end;

function cliWriteln(s: TSocket; const r: string): boolean;
var
  ts: string;
begin
  ts := r + #10;
  Result := cliSendAll(s, ts[1], length(ts));
end;


function cliReadln_(var sock: TSocket): ShortString;
var
  buf: ShortString;
  kw: integer;
  tam: integer;
  nleidos: integer;
  socketCerrado: boolean;

begin
  tam := 255;
  kw := 1;
  buf[0] := #0;
  socketCerrado := False;
  nleidos := 0;
  while ((tam > 0)
      //and ( buf[kw-1] <> #13 )
      and (buf[kw - 1] <> #10)) and not socketCerrado do
  begin
{$IFDEF LINUX}
    nleidos := fpRecv(sock, @buf[kw], tam, 0);
{$ELSE}
    nleidos := recv(sock, buf[kw], tam, 0);
{$ENDIF}
    if nleidos > 0 then
    begin
      kw := kw + nleidos;
      tam := tam - nleidos;
    end
    else
      socketCerrado := True;
  end;

  nleidos := kw - 1;

  while (nleidos > 0) and ((buf[nleidos] = #13) or (buf[nleidos] = #10)) do
    Dec(nleidos);

  buf[0] := chr(nleidos);
  Result := buf;
end;


procedure eliminarFicha(iFichaConSocket: integer);
var
  smf_ListaConexiones: TMutex;
begin
{$IFDEF LINUX}
  smf_ListaConexiones := TMutex.Create(keySmfListaConexiones, 1);
{$ELSE}
  smf_ListaConexiones := TMutex.Create(nom_Smf_ListaConexiones);
{$ENDIF}
  if smf_ListaConexiones.Get(1000) then
  begin
    closesocket(TFichaConexion(listaConexiones[iFichaConSocket]).socket);
    TFichaConexion(listaConexiones[iFichaConSocket]).Free;
    listaConexiones.Delete(iFichaConSocket);
    smf_ListaConexiones.Release;
  end
  else
{$IFDEF LINUX}
    raise Exception.Create('udlginter.eliminarFicha: no pude obtener el semaforo ' +
      keySmfListaConexiones);
{$ELSE}
  raise Exception.Create('udlginter.eliminarFicha: no pude obtener el semaforo ' +
    nom_Smf_ListaConexiones);
{$ENDIF}
  smf_ListaConexiones.Free;
end;



(*** Busca en la lista de conexiones a ver si ya tiene un socket abierto
con el nodo destino, si es así retorna el ordinal de la conexión
si no existe uno socket abierto lo crea, lo agrega a la lista y retorna el
ordinal **)

function getISocket(idNodoDestino: cardinal; timeOut_ms: cardinal): integer;
var
  i, res: integer;
  smf_ListaConexiones: TMutex;
  topotx: TSocket;
  r: ShortString;
  timeOut: TimeVal;
begin
  res := -1;
{$IFDEF LINUX}
  smf_ListaConexiones := TMutex.Create(keySmfListaConexiones, 1);
{$ELSE}
  smf_ListaConexiones := TMutex.Create(nom_Smf_ListaConexiones);
{$ENDIF}
  if smf_ListaConexiones.Get(1000) then
  begin
    for i := 0 to listaConexiones.Count - 1 do
      if TFichaConexion(listaConexiones[i]).idNodoDestino = idNodoDestino then
      begin
        res := i;
        break;
      end;

    if res = -1 then
    begin
      if cliOpen(topotx, idNodoDestino, PuertoTopo, timeOut_ms) then
      begin
        writeln('Abri nuevo socket: ', topotx);
        r := cliReadln_(topotx);
        if r = '+?topo' then
          res := listaConexiones.Add(TFichaConexion.Create(idNodoDestino,
            topotx, timeOut_ms))
        else
        begin
          closesocket(topotx);
          logError('getISocket: r <> +?topo');
        end;
      end
      else
        logError('getISocket: Error abriendo socket');
    end
    else
    if TFichaConexion(listaConexiones[res]).timeOut_ms <> timeOut_ms then
    begin
      timeOut.tv_sec := timeOut_ms div 1000;
      timeOut.tv_usec := 0;
      //          if setsocketoptions( sock, SOL_SOCKET, SO_RCVTIMEO, timeOut, SizeOf(timeOut)) <> 0 then
    {$IFDEF LINUX}
      if fpSetsockopt(TFichaConexion(listaConexiones[res]).socket,
        SOL_SOCKET, SO_RCVTIMEO, @timeOut, SizeOf(timeOut)) <> 0 then
    {$ELSE}
        if setsockopt(TFichaConexion(listaConexiones[res]).socket,
          SOL_SOCKET, SO_RCVTIMEO, @timeOut, SizeOf(timeOut)) <> 0 then
    {$ENDIF}
        begin
          logError('cliOpen: Error fijando timeOut de lectura, WSAGetLastError= ' +
            IntToStr(WSAGetLastError));
          eliminarFicha(res);
          res := -1;
        end
        else
        //          if setsocketoptions(topotx, SOL_SOCKET, SO_SNDTIMEO, timeOut, SizeOf(timeOut)) <> 0 then
    {$IFDEF LINUX}
        if fpSetsockopt(TFichaConexion(listaConexiones[i]).socket,
          SOL_SOCKET, SO_SNDTIMEO, @timeOut, SizeOf(timeOut)) <> 0 then
    {$ELSE}
          if setsockopt(TFichaConexion(listaConexiones[i]).socket,
            SOL_SOCKET, SO_SNDTIMEO, @timeOut, SizeOf(timeOut)) <> 0 then
    {$ENDIF}
          begin
            logError('cliOpen: Error fijando timeOut de escritura, WSAGetLastError= ' +
              IntToStr(WSAGetLastError));
            eliminarFicha(res);
            res := -1;
          end;
      TFichaConexion(listaConexiones[res]).timeOut_ms := timeOut_ms;
    end;
    smf_ListaConexiones.Release;
  end
  else
{$IFDEF LINUX}
    logError('getISocket: Error obteniendo semaforo ' + keySmfListaConexiones);
{$ELSE}
  logError('getISocket: Error obteniendo semaforo ' + nom_Smf_ListaConexiones);
{$ENDIF}

  smf_ListaConexiones.Free;
  Result := res;
end;

{$IFDEF LINUX}
function GetCurrentProcessId: cardinal;
begin
  Result := fpgetpid;
end;

{$ENDIF}

function comunicar_remoto(pfc: PFichaComunicado; pdatos: pointer;
  timeOutCom: integer; idPet: cardinal): cardinal;

var
  r: string;
  topotx: TSocket;
  iFichaCon: integer;
  timeOut: TimeVal;

{$IFDEF CONLOG}
  idTarea: cardinal;
  lparam: integer;
{$ENDIF}
  res: cardinal;
  smf_Conexion: TMutex;

  cnt_intentos: integer;
begin
{$IFDEF CONLOG}
  conlog('ComunicarRemoto...begin', idPet, 0);
  idTarea := 0;
  lparam := 0;
{$ENDIF}
  res := 0;


  //impongo el id del nodo origen al de la maquina de este topo
  pfc^.idNodoOrigen := getIdNodoLocal;

  cnt_intentos := 0;
  repeat
    Inc(cnt_intentos);
    iFichaCon := getISocket(pfc^.idNodoDestino, timeOutCom);
    if iFichaCon <> -1 then
    begin
{$IFDEF LINUX}
      smf_Conexion := TMutex.Create(keySmfConexion, GetCurrentProcessId * 1024 +
        iFichaCon);
{$ELSE}
      smf_Conexion := TMutex.Create(base_nom_Smf_Conexion +
        IntToStr(GetCurrentProcessId) + IntToStr(iFichaCon));
{$ENDIF}
      if smf_Conexion.Get(600) then
      begin

        topotx := TFichaConexion(listaConexiones[iFichaCon]).socket;
        if cliWriteln(topotx, '+MsgAsn') then
        begin
          r := cliReadln_(topotx);
          if r = '+send_MsgAsn' then
          begin
            //      writeln( 'length(fc): '+ IntToStr(length( fc )) );
            if cliSendAll(topotx, pfc^, sizeOf(pfc^)) then
            begin
              r := cliReadln_(topotx);
              if r = '+OkFC' then
              begin
                if pfc^.nbytesdatos > 0 then
                begin
                  if cliSendAll(topotx, pdatos^, pfc^.nBytesDatos) then
                  begin
                    r := cliReadln_(topotx);
                    if r = '+OkDatos' then
                    begin
                      res := idPet;
                    end
                    else
                      logError('ComunicarRemoto: No recibí confirmación de datos');
                  end
                  else
                    logError('ComunicarRemoto: Error enviando pdatos');
                end
                else
                  res := idPet;
        {$IFDEF DBGLOG}
                dbglog('ComunicarRemoto: idPeticion= ' + IntToStr(idPet) +
                  GenFCStr(pfc, nil));
        {$ENDIF}
              end
              else
                logError('ComunicarRemoto: No recibí confirmación de ficha comunicado.');
            end
            else
              logError('ComunicarRemoto: Error enviando pfc');
          end
          else
            logError('ComunicarRemoto: r <> +send_MsgAsn');
        end
        else
          logError('ComunicarRemoto: Error escribiendo +MsgAsn');
        smf_Conexion.Release;
      end
      else
{$IFDEF LINUX}
        logError('ComunicarRemoto: Error obteniendo semaforo ' +
          keySmfConexion + '(' + IntToStr(GetCurrentProcessId) + ', ' + IntToStr(iFichaCon) + ')');
{$ELSE}
      logError('ComunicarRemoto: Error obteniendo semaforo ' +
        base_nom_Smf_Conexion + IntToStr(GetCurrentProcessId) + IntToStr(iFichaCon));
{$ENDIF}
      smf_Conexion.Free;
    end;

    if (res = 0) and (iFichaCon <> -1) then
    begin
      eliminarFicha(iFichaCon);
    end;
  until (res > 0) or (cnt_intentos >= MAX_REINTENTOS_COMUNICACION);

  Result := res;
{$IFDEF CONLOG}
  conlog('ComunicarRemoto...end:' + IntToStr(idTarea), idPet, lparam);
{$ENDIF}
end;



function comunicar_local(pfc: PFichaComunicado; pdatos: pointer;
  idPet: cardinal): cardinal;
var
  smf: TMutex;
  pfp: PFichaPeticion;

begin
  {$IFDEF LINUX}
  smf := TMutex.Create(keySmfPeticiones, 1);
 {$ELSE}
  smf := TMutex.Create(nom_Smf_Peticiones);
 {$ENDIF}
  Result := 0;
  if not smf.Get(5000) then
  begin
    setUltimoError(ERROR_NoConseguiSemaforo);
    logError('comunicar: no consegui SmfPeticiones');
    smf.Free;
    exit;
  end;

  pfp := getPrimerFichaPeticionLibre;
  if pfp = nil then
  begin
    setUltimoError(ERROR_NoHayPeticionesLibres);
    logError('comunicar: no hay fichas de peticion libres');
    smf.Release;
    smf.Free;
    exit;
  end;

  pfp^.idPeticion := idPet;
  pfp^.dtInicio := now;
  pfp^.dtVencimiento := pfp^.dtInicio + DEF_TIMEOUT_DT;
  pfp^.fc := pfc^;
  pfp^.fc.pdatos := nil;

  if pfc^.NBytesDatos > MAX_SIZE_BUFFER_CHICO then
  begin
     {$IFDEF HEAPMANAGER}
    pfp^.kBloqueLongBuffer := heapManager.block_alloc(pfc^.NBytesDatos);
    if pfp^.kBloqueLongBuffer > 0 then
      pfp^.fc.pdatos := heapManager.block_ptr(pfp^.kBloqueLongBuffer)
    else
    begin
      setUltimoError(ERROR_Comunicar_NoHayBloqueLongBufferLibre);
      logError('comunicar: no hay espacio o bloques libres en el heap para enviar el comunicado');
      smf.Release;
      smf.Free;
      exit;
    end;
     {$ELSE}
    setUltimoError(ERROR_Comunicar_MAX_SIZE_BUFFER_CHICO_insuficiente);
    logError('comunicar: ' + IntToStr(
      pfc^.NBytesDatos) + ' > MAX_SIZE_BUFFER_CHICO (' + IntToStr(MAX_SIZE_BUFFER_CHICO) + ')');
    smf.Release;
    smf.Free;
    exit;
     {$ENDIF}
  end
  else
  begin
    // No es necesario un LongBuffer
    pfp^.fc.pdatos := @pfp^.bufferDatosChico[0];
       {$IFDEF HEAPMANAGER}
    pfp^.kBloqueLongBuffer := -1;
       {$ENDIF}
  end;
  if pdatos <> nil then
    Move(pdatos^, pfp^.fc.pdatos^, pfc^.NBytesDatos);

  if (pfc^.idNodoDestino <> 255) then
  begin
    // local delivery sencillo
    if pfc^.idDestino = 0 then
      pfp^.fc.idDestino := pm^.idTopoLocal;
       {$IFDEF LINUX}
    if colaDeMensajes.PostMessage(pfp^.fc.idDestino, pfp^.fc.codigomsg,
      pfp^.idPeticion, pfp^.fc.lParam) <> 0 then
       {$ELSE}
      if not PostMessage(pfp^.fc.idDestino, pfp^.fc.codigomsg,
        pfp^.idPeticion, pfp^.fc.lParam) then
       {$ENDIF}
      begin
        setUltimoError(ERROR_FalloPostMessage);
       {$IFDEF LINUX}
        logError('comunicar,local: falloPostMessage' + strerror(errno));
       {$ELSE}
        logError('comunicar,local: falloPostMessage' + IntToStr(GetLastError));
       {$ENDIF}

        {$IFDEF HEAPMANAGER}
        if pfp^.kBloqueLongBuffer > 0 then
          heapManager.block_free(pfp^.kBloqueLongBuffer);
         {$ENDIF}

        liberarPeticion(pfp);
        smf.Release;
        smf.Free;
        exit;
      end;
  end
  else //Comunicar Tarea Sincrona , idNodoDestino=255
  begin

    if pm^.idTopoLocal = 0 then
    begin
      setUltimoError(ERROR_NoHayTopoLocalRegistrado);
      logError('comunicar,local,idDestino=255: no hay topo local registrado');
         {$IFDEF HEAPMANAGER}
      if pfp^.kBloqueLongBuffer > 0 then
        heapManager.block_free(pfp^.kBloqueLongBuffer);
         {$ENDIF}
      liberarPeticion(pfp);
      smf.Release;
      smf.Free;
      exit;
    end;

    pfc^.idNodoDestino := 0;
       {$IFDEF LINUX}
    if colaDeMensajes.PostMessage(pm^.idTopoLocal,
      uconstantes_nettopos.MSG_RESPUESTA_TS, pfp^.idPeticion,
      0) <> 0 then
       {$ELSE}
      if not PostMessage(pm^.idTopoLocal,
        uconstantes_nettopos.MSG_RESPUESTA_TS, pfp^.idPeticion,
        0) then
       {$ENDIF}
      begin
        setUltimoError(ERROR_FalloPostMessage);
        logError('comunicar,local,idDestino=255: fallo post message MSG_RESPUESTA_TS');
        liberarPeticion(pfp);
         {$IFDEF HEAPMANAGER}
        if pfp^.kBloqueLongBuffer > 0 then
          heapManager.block_free(pfp^.kBloqueLongBuffer);
         {$ENDIF}
        smf.Release;
        smf.Free;
        exit;
      end;
  end;

  idPet := pfp^.idPeticion;
  smf.Release;
  smf.Free;

  Result := idPet;

end;

(*+doc
Envia un comunicado a la aplicación destino en el nodo destino
Si el idNodoDestino es 0 o es igual al id de la aplicación
registrada como topo_local el mensaje se distribuye localmente
si el idTopoDestino <> 0 y no es el id del local, el mensaje
se envía al topo remoto. *)
function comunicar(pfc: PFichaComunicado; pdatos: pointer;
  timeOutCom_ms: integer): cardinal; stdcall;
var
  idPet: cardinal;
begin
{$IFDEF DBGLOG}
  dbglog('Comunicar(' + GenFCStr(pfc, pdatos) + '), processID= ' +
    IntToStr(getCurrentProcessID()));
{$ENDIF}

  assert(pfc <> nil, 'comunicar: la aplicacion ' + IntToStr(pfc^.idOrigen) +
    ' pidio un comunicar con pfc = nil');
  assert((pdatos <> nil) or (pfc^.nBytesDatos = 0), 'comunicar: la aplicacion ' +
    IntToStr(pfc^.idOrigen) + ' pidio un comunicar con ((pdatos=nil) AND (nBytesSatos > 0)');
  assert((pfc^.idNodoDestino <> 255) or (pm^.idTopoLocal <> 0),
    'comunicar: la aplicacion ' + IntToStr(pfc^.idOrigen) +
    ' pidio un comunicar para respuestaTS con idTopoLocal = 0');

  idPet := NextNIDPeticionVal;

  if (pfc^.idNodoDestino = 0) or (pfc^.idNodoDestino = pm^.idNodoLocal) or
    (pfc^.idNodoDestino = 255) then
  begin //Comunicar local o Comunicar Tarea Sincrona
{$IFDEF DBGLOG}
    dbglog('Comunicar,local... ');
{$ENDIF}
    Result := comunicar_local(pfc, pdatos, idPet);
  end
  else //Comunicar Remoto
  begin
{$IFDEF DBGLOG}
    dbglog('Comunicar,remoto... ');
{$ENDIF}
    Result := Comunicar_remoto(pfc, pdatos, timeOutCom_ms, idPet);
  end;
{$IFDEF DBGLOG}
  dbglog('comunicar->');
{$ENDIF}
end;


(*+doc
Envia un comunicado en forma de Tarea Sincrona. El comunicado es enviado,
y la función no retorna hasta que se recibe la respuesta o hasta que
halla transcurrido el tiempo timeout expresado en milisegundos.
El resultado de esta función es el identificador del comunicado de
respuesta para que se puedan leer los datos y levantar el comunicado.
-doc*)
function comunicarTS(pfc: PFichaComunicado; pdatos: pointer;
  timeout_ms: integer): cardinal; stdcall;
var
  smfTS: TMutex;
  pfts: PRecFichaTareaSincrona;
  idPet: cardinal;
  //  dt: TDateTime;
{$IFDEF LINUX}
  evento: TEventRX;
{$ELSE}
  evento: TEvent;
{$ENDIF}
  ok: boolean;
label
  lbl_fin;
begin
{$IFDEF DBGLOG}
  dbglog('ComunicarTS(' + GenFCStr(pfc, pdatos) + ' ) timeout:' + IntToStr(timeout_ms));
{$ENDIF}
  //  smf:= NIL;
  //  smfTS:= NIL;
  //  evento:= NIL;
  Result := 0;

  assert(pfc <> nil, 'comunicarTS( con pfc= nil)');
  assert((pdatos <> nil) or (pfc^.nBytesDatos = 0), 'comunicarTS: la aplicacion ' +
    IntToStr(pfc^.idOrigen) +
    ' pidio un comunicarTS con ((pdatos=nil) AND (nBytesSatos > 0)');
  //  assert(pfc^.idOrigen <> pm^.idTopoLocal, 'comunicarTS: Pidieron un comunicarTS desde el topo');
  assert(pfc^.idOrigen <> pfc^.idDestino, 'comunicarTS: la aplicacion ' +
    IntToStr(pfc^.idOrigen) + ' pidio un comunicarTS a si misma');
  assert(pm^.idTopoLocal <> 0, 'comunicarTS: la aplicacion ' +
    IntToStr(pfc^.idOrigen) + ' pidio un comunicarTS sin que hubiera un topo registrado');


  // generamos el número UNICO_LOCAL de petición.
  idPet := NextNIDPeticionVal;


{$IFDEF LINUX}
  evento := TEventRX.Create(keyArchiEventos, idPet);
  smfTS := TMutex.Create(keySmfTopoTareasSincronas, 1);
{$ELSE}
  evento := TEvent.Create(nombreEvento(idPet), False);
  smfTS := TMutex.Create(nom_Smf_topo_tareassincronas);
{$ENDIF}
  if not smfTS.Get(1000) then
    goto lbl_fin;

  // TENGO EL SEMAFORO TareasSincronas ---------
  pfts := getPrimerFichaTSinLibre;
  if pfts = nil then
  begin
    smfTS.Release;
    logError('ComunicarTS: no quedan tareas sincronas libres');
    goto lbl_fin;
  end;

  with pfts^ do
  begin
    idPeticion := idPet;

    // guardamos el identificador Original
    idTareaOriginal := pfc^.idTarea;

    // obtenemos el identificador de tarea síncrona (único local)
    idTareaSincrona := pm^.nextIdTareaSincrona;

    // cambiamos en el comunicado el idTarea para apuntarlo a la síncrona
    pfc^.idTarea := idTareaSincrona;
  end;

  Inc(pm^.nextIdTareaSincrona);
  smfTS.Release;
  // liberamos el semáforo TareasSincronas --------------


  if (pfc^.idNodoDestino = 0) or (pfc^.idNodoDestino = pm^.idNodoLocal) then
    //ComunicarTS Local -> envio msg a la aplicacion
  begin
    //con esto le indicamos a la librería que es una tarea sincrona local y que nos devuelva por MSGR_RESPUESTA_TS
    pfc^.idNodoOrigen := 255;
    ok := comunicar_local(pfc, pdatos, idPet) = idPet;
  end
  else //ComunicarTS Remoto -> envio msg a traves del socket
  begin
    // con esto le indicamos al Topo que cuando reciba la respuesta la maneje como tarea sincrona
    pfc^.idOrigen := pm^.idTopoLocal;
    ok := comunicar_remoto(pfc, pdatos, timeout_ms, idPet) = idPet;
  end;

  if ok then
  begin
    writeln('ComunicarTS.Mensaje enviado OK, me siento a esperar la respuesta ');
    if not evento.Wait(timeout_ms) then
    begin
      writeln('ComunicarTS.Salí por TimeOut');
      logError('ComunicarTS: supere el tiempo de espera asignado');
      ok := False;
    end
    else
    begin
      writeln('ComunicarTS.Sali por Recibir la Respuesta en Tiempo!.');
      if smfTS.Get(1000) then
      begin
        pfts^.idPeticion := 0;
        smfTS.Release;
      end;
      Result := idPet;
    end;
  end
  else
    logError('ComunicarTS: envío del mensaje.');

  if not ok then
  begin
    if smfTS.Get(1000) then
    begin
      pfts^.idPeticion := 0;
      smfTS.Release;
    end;
  end;

  lbl_fin:
    if smfTS <> nil then
      smfTS.Free;
  if evento <> nil then
    evento.Free;
{$IFDEF DBGLOG}
  dbglog('Fin ComunicarTS idPeticion= ' + IntToStr(idPet));
{$ENDIF}
end;

(*+doc
Esta función es para uso exclusivo de la aplicación Topo y lo que hace
es notificar la respuesta a un proceso que ha quedado esperándo luego
de llamar a comunicarTS.
-doc*)
function respuestaTS(idPeticion, idTarea: cardinal; pfc: PFichaComunicado;
  pdatos: pointer): cardinal; stdcall;
var
  smf: TMutex;
{$IFDEF LINUX}
  evento: TEventTX;
{$ELSE}
  evento: TEvent;
{$ENDIF}
  pfp: PFichaPeticion;
begin
{$IFDEF DBGLOG}
  dbglog('respuestaTS(' + GenFCStr(pfc, pdatos) + ') ');
{$ENDIF}

{$IFDEF LINUX}
  smf := TMutex.Create(keySmfPeticiones, 1);
{$ELSE}
  smf := TMutex.Create(nom_Smf_Peticiones);
{$ENDIF}
  Result := 0;

  if not smf.Get(600) then
  begin
    setUltimoError(ERROR_NoConseguiSemaforo);
    smf.Free;
    exit;
  end;

  pfp := getPrimerFichaPeticionLibre;
  if pfp = nil then
  begin
    setUltimoError(ERROR_NoHayPeticionesLibres);
    smf.Release;
    smf.Free;
    exit;
  end;

  pfp^.idPeticion := idPeticion;
  pfp^.dtInicio := now;
  pfp^.dtVencimiento := pfp^.dtInicio + DEF_TIMEOUT_DT;
  pfp^.fc := pfc^;
  pfp^.fc.idTarea := idTarea;

  if pfc^.NBytesDatos > MAX_SIZE_BUFFER_CHICO then
  begin
    {$IFDEF HEAPMANAGER}
    pfp^.kBloqueLongBuffer := heapManager.block_alloc(pfc^.NBytesDatos);
    if pfp^.kBloqueLongBuffer > 0 then
      pfp^.fc.pdatos := heapManager.block_ptr(pfp^.kBloqueLongBuffer)
    else
    begin
      //setUltimoError( ERROR_NoHayPeticionesLibres );
      logError('respuestaTS: no hay espacio o bloques libres en el heap para enviar el comunicado');
      liberarPeticion(pfp);
      smf.Release;
      smf.Free;
      exit;
    end;
    {$ELSE}
    logError('respuestaTS: largo datos mayor que buffer chicho y compilado sin soporte de buffer grande');
    liberarPeticion(pfp);
    smf.Release;
    smf.Free;
    exit;
    {$ENDIF}
  end
  else
    pfp^.fc.pdatos := @pfp^.bufferDatosChico[0];

  if pdatos <> nil then
    Move(pdatos^, pfp^.fc.pdatos^, pfc^.NBytesDatos);

  Result := pfp^.idPeticion;
  smf.Release;
  smf.Free;
{$IFDEF LINUX}
  evento := TEventTX.Create(keyArchiEventos, idPeticion);
{$ELSE}
  evento := TEvent.Create(nombreEvento(idPeticion), False);
{$ENDIF}
  evento.Signal;
  evento.Free;
end;

(*+doc
Esta función debe ser usada por las aplicaciones para leer los datos
asociados a un comunicado.
Tanto cuando una aplicación recibe un mensaje de comunicado en forma asíncrona
o cuando sale de una llamada a comunicarTS, la aplicación dispone del
identificador del comunicado y debe llamar esta función para leer la ficha
del comunicado. Luego de leer la ficha debe llamar a levantarDatos
para terminar de leer el comunicado.
El parámetro pfc debe apuntar a un área de memoria donde la función
copiará la ficha del comunicado.
Si se produce un error el resultado es CERO.
-doc*)
function leerFichaComunicado(idComunicado: cardinal;
  pfc: PFichaComunicado): cardinal; stdcall;
var
  smfPeticiones: TMutex;
  pp: PFichaPeticion;
begin
{$IFDEF DBGLOG}
  dbglog('leerFichaComunicado->' + IntToStr(idComunicado));
{$ENDIF}
  Result := 0;
{$IFDEF LINUX}
  smfPeticiones := TMutex.Create(keySmfPeticiones, 1);
{$ELSE}
  smfPeticiones := TMutex.Create(nom_Smf_Peticiones);
{$ENDIF}
  if not smfPeticiones.Get(10000) then
  begin
    setUltimoError(ERROR_NoConseguiSemaforo);
    logError('leerFichaComunicado: ERROR_NoConseguiSemaforo');
    smfPeticiones.Free;
    exit;
  end;

  pp := getPeticionById(idComunicado);
  if pp = nil then
  begin
    setUltimoError(ERROR_idPeticion_NoEncontrado);
    logError('leerFichaComunicado: ERROR_idPeticion_NoEncontrado');
    smfPeticiones.Release;
    smfPeticiones.Free;
    exit;
  end;

  if pp^.fc.NBytesDatos > MAX_SIZE_BUFFER_CHICO then
  begin
    {$IFDEF HEAPMANAGER}
    if pp^.kBloqueLongBuffer > 0 then
      pp^.fc.pdatos := heapManager.block_ptr(pp^.kBloqueLongBuffer)
    else
    begin
      setUltimoError(ERROR_CreandoLongBufferPeticion);
      logError('leerFichaComunicado: comunicado con LongBuffer y pp^.kBloqueLongBuffer = '
        + IntToStr(pp^.kBloqueLongBuffer));
      liberarPeticion(pp);
      smfPeticiones.Release;
      smfPeticiones.Free;
      exit;
    end;
    {$ELSE}
    setUltimoError(ERROR_CreandoLongBufferPeticion);
    logError('leerFichaComunicado: largo datos > buffer chicho y compilado sin soporte de buffer granda');
    liberarPeticion(pp);
    smfPeticiones.Release;
    smfPeticiones.Free;
    exit;
    {$ENDIF}

  end
  else
  begin
    pp^.fc.pdatos := @pp^.bufferDatosChico[0];
    {$IFDEF HEAPMANAGER}
    pp^.kBloqueLongBuffer := -1;
    {$ENDIF}
  end;

  pfc^ := pp^.fc;
  smfPeticiones.Release;
  smfPeticiones.Free;
  Result := idComunicado;
{$IFDEF DBGLOG}
  dbglog('<-leerfichaComunicado: idPeticion= ' + IntToStr(idComunicado) +
    ', ' + GenFCStr(pfc, nil) + ') ');
{$ENDIF}
end;

function levantarDatosComunicado(idComunicado: cardinal; pdatos: pointer;
  nbytes: cardinal): cardinal; stdcall;
var
  smfPeticiones: TMutex;
  pp: PFichaPeticion;
  res: cardinal;
label
  lbl_fin1, lbl_fin2;
begin
  res := 0;
{$IFDEF DBGLOG}
  pp := nil;
{$ENDIF}

{$IFDEF LINUX}
  smfPeticiones := TMutex.Create(keySmfPeticiones, 1);
{$ELSE}
  smfPeticiones := TMutex.Create(nom_Smf_Peticiones);
{$ENDIF}
  if not smfPeticiones.Get(10000) then
  begin
    setUltimoError(ERROR_NoConseguiSemaforo);
    goto lbl_fin2;
  end;

  pp := getPeticionById(idComunicado);
  if pp = nil then
  begin
    setUltimoError(ERROR_idPeticion_NoEncontrado);
    goto lbl_fin1;
  end;


  if nbytes > pp^.fc.NBytesDatos then
  begin
    logError('OJO; levantar comunicados: pp^.fc.NBytesDatos: ' +
      IntToStr(pp^.fc.NBytesDatos) + ' nbytes: ' + IntToStr(nbytes));

    if nbytes > pp^.fc.NBytesDatos then
    begin
      nbytes := pp^.fc.NBytesDatos;
    end;
  end;

  if pdatos <> nil then
    Move(pp^.fc.pdatos^, pdatos^, nBytes);

  {$IFDEF HEAPMANAGER}
  if pp^.kBloqueLongBuffer > 0 then
  begin
    heapManager.block_free(pp^.kBloqueLongBuffer);
  end;
  {$ENDIF}

  liberarPeticion(pp);
  res := idComunicado;

  lbl_fin1:
    smfPeticiones.Release;
  lbl_fin2:
    smfPeticiones.Free;

  Result := res;
{$IFDEF DBGLOG}
  if pp <> nil then
    dbglog('levantarDatosComunicado res:' + IntToStr(res) + ' ' + GenFCStr(
      @(pp^.fc), pdatos) + ') ')
  else
    dbglog('levantarDatosComunicado res:' + IntToStr(res) + ' pp= nil  ');
{$ENDIF}
end;

//Retorna el identificador asociado a nombreAplic en la librería
//Si no se encuentra una aplicación con ese nombre retorna -1
function getIdAplicacion(idNodo: cardinal; nombreAplic: PChar): cardinal; stdcall;
var
  smf: TMutex;
  res: cardinal;
  fc: TFichaComunicado;
  idPeticion: cardinal;
begin
  writeln('getIdAplicacion, idNodo: ', idNodo);

  if (idNodo = 0) or (idNodo = pm^.idNodoLocal) then
  begin
{$IFDEF LINUX}
    smf := TMutex.Create(keySmfAplics, 1);
{$ELSE}
    smf := TMutex.Create(nom_Smf_Aplics);
{$ENDIF}
    if not smf.Get(1000) then
    begin
      setUltimoError(ERROR_NoConseguiSemaforo);
      smf.Free;
      Result := 0;
      exit;
    end;

    Result := getAplicIdByName(nombreAplic);
    smf.Release;
    smf.Free;
  end
  else
  begin
    fc.idNodoOrigen := pm^.idNodoLocal;
    fc.idOrigen := idAplicYo;
    fc.idNodoDestino := idNodo;
    fc.idDestino := 0;
    fc.codigoMsg := MSGP_GETIDAPLICBYNAME;
    fc.nBytesDatos := Length(nombreAplic);
    idPeticion := comunicarTS(@fc, nombreAplic, 5000);
    if idPeticion > 0 then
    begin
      leerFichaComunicado(idPeticion, @fc);
      levantarDatosComunicado(idPeticion, @res, sizeOf(res));
    end
    else
      res := 0;
    Result := res;
  end;
end;

function getNombreAplicacion(idNodo: cardinal;
  idAplic: cardinal): ShortString; stdcall;
var
  smf: TMutex;
  res: shortstring;
  fc: TFichaComunicado;
  idPeticion: cardinal;
begin
  if (idNodo = 0) or (idNodo = pm^.idTopoLocal) then
  begin
{$IFDEF LINUX}
    smf := TMutex.Create(keySmfAplics, 1);
{$ELSE}
    smf := TMutex.Create(nom_Smf_Aplics);
{$ENDIF}
    if not smf.Get(1000) then
    begin
      setUltimoError(ERROR_NoConseguiSemaforo);
      smf.Free;
      Result := '';
      exit;
    end;

    Result := getAplicNameById(idAplic);
    smf.Release;
    smf.Free;
  end
  else
  begin
    fc.idNodoDestino := idNodo;
    fc.codigoMsg := MSGP_GETIDAPLICBYNAME;
    fc.nBytesDatos := SizeOf(idAplic);
    idPeticion := comunicarTS(@fc, @idAplic, 10000);
    if idPeticion > 0 then
    begin
      leerFichaComunicado(idPeticion, @fc);
      levantarDatosComunicado(idPeticion, @res, sizeOf(res));
    end
    else
      res := '';
    Result := res;
  end;
end;

function inicializar:Boolean; stdcall;

var
{$IFDEF WINDOWS}
  wsadata: twsadata;
{$ENDIF}
 smf: TMutex;
begin
  writeln('->utoposock.inicializar');
  result:=true;
  //semaforo para asegurar la inicializacion de una aplic a la vez.

{$IFDEF LINUX}
    smf := TMutex.Create(keySmfInitFinNettopos, 1);
{$ELSE}
    smf := TMutex.Create(nom_smf_initfin_nettopos);
{$ENDIF}

  if not smf.Get(2000) then
  begin
   writeln('No consegui semaforo initfinNettopos');
   result:= false;
   smf.Free;
   exit;
  end;

  if ConectarShareMem = 0 then
  begin
    writeln('Inicializando por primera vez DlginterShareMem');
    InicializarValoresSharedMem;
  end
  else
  begin
    writeln('Ya existia DlginterShare me salteo inicializar');
  end;

{$IFDEF WINDOWS}
  WSAStartUp(2 * 16 + 2, wsadata);
{$ENDIF}
  listaConexiones := TList.Create;
  writeln('utoposock.inicializar->');

  smf.Release;
  smf.Free;

end;

procedure finalizar; stdcall;
var
  i: integer;
  smf: TMutex;
begin
{$IFDEF WINDOWS}
  WSACleanUp;
{$ENDIF}

{$IFDEF LINUX}
    smf := TMutex.Create(keySmfInitFinNettopos, 1);
{$ELSE}
    smf := TMutex.Create(nom_smf_initfin_nettopos);
{$ENDIF}
if not smf.Get(2000) then
  begin
   writeln('No consegui semaforo initfinNettopos');
   smf.Free;
   exit;
  end;

  writeln('unettopos.finalizar: unlinking SHARE');
  DesconectarShareMem;

  for i := 0 to listaConexiones.Count - 1 do
  begin
    closesocket(TFichaConexion(listaConexiones[i]).socket);
    TFichaConexion(listaConexiones[i]).Free;
  end;
  listaConexiones.Free;

  smf.Release;
  smf.Free;

end;

{$IFDEF LINUX}
function xGetMessage_WAIT(var m: TWinMsg): integer; stdcall;
begin
  Result := ColaDeMensajes.GetMessage(m);
end;

function xGetMessage_NOWAIT(var m: TWinMsg): integer; stdcall;
begin
  Result := ColaDeMensajes.GetMessageNoWait(m);
end;

function xPostMessage(idDestino: integer; msgCode: cardinal;
  wParam: word; lParam: longint): integer; stdcall;
begin
  Result := ColaDeMensajes.PostMessage(idDestino, msgCode, wParam, lParam);
end;

{$ENDIF}

end.
