{xDEFINE DBG_MUTEX}

unit uEmuladorWinIPC;
{ feb.2002.rch@todo.com.uy
Intetamos emular las funciones de comunicación
entre ventanas de Windows.

(los mensajes están emulados en uWinMsgs )
}

interface
uses
  ERRORS,
  Classes,
  SysUtils,
  baseunix, ipc,
  uSemaforoPolenta, uKeyDir;

(*const
// SEMAFOROS -- camino a archivos KEY

{ Utilizada en uSignals.pas para la señalización
de las líneas con TEventTX y TEventRX. El código
agregado es 100+nlina }
   keyArchiEventos2= keyBaseDir+'/keyEventos';

{ Utilizada en  dialogicsrv. El código agregado
es nlinea. Se utiliza tanto por func_handler para
procesar eventos de la tarjeta como por la FORM
para respuesta a los mensajes enviados por la Dlginter }
   keymtx_DlgSrvLine2= keyBaseDir+'/keymtx_DlgSrvLine';

// Dlginter codigo 1
   keyNextNidLlamada2= keyBaseDir+'/keyNextNidLlamada';

{usado en ulog.log_nlin agregando 100+nlin de código
La función log_nlin parece que no es utilizada por
nadie y or eso está comentada en la interface de ulog
}
   keyArchiLogs2= keyBaseDir+'/keyLogs';

// ulog con código 1
   keyArchiDBGLog2= keyBaseDir+'/keyArchiLog';

// ulog codigo 1
   keymtx_ErrorLog2= keyBaseDir+'/keymtx_ErrorLog';


// SHARES de MEMORIA
   keyDlginterShareMem= keyBaseDir+'/keyShareMem';


// Key de configuraciones
   keyConfiguraciones= keyBaseDir+'/keyConfigs';


// Key de líneas de la tarjeta
   keyLineasTarjeta= keyBaseDir+'/keyLineasTarjetas';

// Key de gatillos
  keyGatillos= keyBaseDir+'/keyGatillos';  *)

const
   WM_USER = $0400;
   DLL_PROCESS_ATTACH = 0; // ?? investigar el valor
   DLL_PROCESS_DETACH = 1; // ?? investigar el valor

   PAGE_READWRITE = 0; // ?? revisar para Crear el Share
   ERROR_ALREADY_EXISTS = 0; // ?? si existe el share el valor de GetLastError
   FILE_MAP_WRITE= 0; //?? usada en modo de MapViewOfFile
   SW_Show= 0; // ??? para modo de WinExec

type
   HWND = integer;

  TSocket= cint;

  TMutex = class
  public
    FSemId: integer;
    constructor Create(const Name: string; codigo: integer );
    function Get(TimeOut: Integer): Boolean;
    function Release: Boolean;
    procedure Free; virtual;
  end;

  (*TEvent representa un objeto evento.
    El evento puede estar señalizado o no señalizado.
    Si esta señalizado la llamada a wait retorna inmediatamente
    Si no esta señalizado la llamada a wait espera a que el evento este señalizado
    y si es un evento manual retorna dejando el estado señalizado.
    Si no es manual vuelve a fijar el estado como no señalizado y retorna.
    La funcion signal fija el estado como señalizado y la funcion reset fija el
    estado como no señalizado.
    Todos los hilos que creen el evento deben crearlo con el mismo valor de manual
    o el comportamiento no esta especificado
    Cuando se crea el archivo para el semaforo que soporta los mutex de nombre
    Name se debe crear uno para soportar los de estado de nombre Name + '_Estado'
    y uno para soportar el mutex del wait de nombre Name + '_Wait'
    P.Ej: si el evento se llamara eventoSincro se debe crear un archivo
    eventoSincro, un archivo eventoSincro_Estado y un archivo eventoSincro_Wait
  *)
{  TEvent = class
    private
      FIdSemEstado: integer;        //SemEstado = 0 señalizado
                                    //SemEstado = 1 no señalizado
      FIdSemMutexAcceso: integer;   //Mutex para mutuoexcluir el acceso al valor
                                    //de estado
      FIdSemMutexWait: integer;     //Mutex para tratar la espera como seccion
                                    //critica
      manual: boolean;
    public
  	  constructor Create(const Name: string; codigo: Integer; Manual: Boolean);
	    procedure Signal;
  	  procedure Reset;
	    function Wait(TimeOut: Integer): Boolean;
      procedure Free;
  end;  }

  // Evento para espera (receptor)
  //OJO: al usuar un par TEventRX, TEventTX se debe crear primero el TEventRX
  //sino el TEventTX.Create falla
  TEventRX = class
   FSemId: integer;
   estado: integer;
   constructor Create( claveStr: string; codigo: integer );
   function Wait( ms: integer ): boolean;
   procedure Free; virtual;
  end;

  // Evento para senializar a uno en espera (transmisor )
  TEventTX = class
   FSemId: integer;
   estado: integer;
   constructor Create( claveStr: string; codigo: integer );
   procedure Free; virtual;
   procedure Signal;
  end;

  TSharedMem= class
   FShmId: integer;
   pm: pointer;
   YaExistia: boolean;
   constructor Create( claveStr: string; MemSize: cardinal; subkey: integer );
   procedure Free; virtual;
  end;

{ Retorna el pid del proceso, emulando el handle del a ventana de Windows }
function ProcHandle: integer;

{ Crea un nuevo proceso dependiente de init
y le carga la aplicación en el, mediante una llamada a DoProcesoHijo }
function LanzarApl(
	Apl: string;
  params: array of String): boolean;

{Suplanta el proceso actual por la aplicación.}
procedure DoProcesoHijo(
	Apl: string;
	params: array of String);

implementation

function ProcHandle: integer;
begin
   result:= FPgetpid;
end;

{ TMutex }
constructor TMutex.Create(const Name: string; codigo: integer );
var
  key: key_t;
  s: string;
begin
{$IFDEF DBG_MUTEX}
  writeln('TMutex.Create( '+Name+', '+IntToStr( codigo )+')' );
{$ENDIF}
  inherited create;
  s:= Name+#0;

  key:= ftok( @s[1], codigo );
{$IFDEF DBG_MUTEX}
  Writeln('key= ', key);
{$ENDIF}

  FSemID := uSemaforoPolenta.sem_create(key, 1);

{$IFDEF DBG_MUTEX}
  writeln('Semid: '+ IntToStr( FSemID ) );
{$ENDIF}
  if FSemID < 0 then
  begin
    writeln('TMutex.Create: Error, no puede crear MUTEX con ' + Name);
    halt;
  end;
end;

function TMutex.Get(TimeOut: Integer): Boolean;
begin
  result:= uSemaforoPolenta.sem_timedwait( FSemId, TimeOut ) = 0;
end;

function TMutex.Release: Boolean;
begin
  if (uSemaforoPolenta.sem_signal( FSemId ) < 0) then
  begin
    err_sys('TMutex.Release->sem_op error ' + IntToStr(errno) + ', ' + strerror(errno));
    result:= false;
  end;
  result:= true;
end;

procedure TMutex.Free;
begin
  uSemaforoPolenta.sem_close(FSemId );
{$IFDEF DBG_MUTEX}
  writeln( 'TMutex.Free , FSemId: '+IntToStr( FSemId ) );
{$ENDIF}
  inherited Free;
end;

(*constructor TEvent.Create(const Name: string; codigo: Integer; Manual: Boolean);
var
  keyEstado, keyMutexAcceso, keyMutexWait: key_t;
  s: string;
begin
  inherited create;
  s:= Name+#0;
  keyEstado:= ftok( @s[1], codigo );
  if (keyEstado = key_t(-1)) then
  begin
    writeln('TEvent.Create, Problemas con ftok de FIdSemEstado ( '+Name+', ', codigo, ')');
  	exit;   //* probably an ftok() error by caller */
  end;
  s:= Name+'_Estado'+#0;
  keyMutexAcceso:= ftok( @s[1], codigo );
  if (keyMutexAcceso = key_t(-1)) then
  begin
    writeln('TEvent.Create, Problemas con ftok de FIdSemMutexAcceso ( '+s+', ', codigo, ')');
  	exit;   //* probably an ftok() error by caller */
  end;
  s:= Name+'_Wait'+#0;
  keyMutexWait:= ftok( @s[1], codigo );
  if (keyMutexWait = key_t(-1)) then
  begin
    writeln('TEvent.Create, Problemas con ftok de FIdSemMutexWait ( '+s+', ', codigo, ')');
  	exit;   //* probably an ftok() error by caller */
  end;

  //El estado arranca en 1 -> sin señalizar
  FIdSemEstado:= uSemaforoPolenta.sem_create(keyEstado, 1);
  if FIdSemEstado < 0 then
    err_sys('TEvent.Create->ERR:'+IntToStr(errno));

  FIdSemMutexAcceso:= uSemaforoPolenta.sem_create(keyMutexAcceso, 0);
  if FIdSemMutexAcceso < 0 then
    err_sys('TEvent.Create->ERR:'+IntToStr(errno));

  FIdSemMutexWait:= uSemaforoPolenta.sem_create(keyMutexWait, 0);
  if FIdSemMutexWait < 0 then
    err_sys('TEvent.Create->ERR:'+IntToStr(errno));
  self.manual:= Manual;
end;

procedure TEvent.Signal;
begin
  raise exception.Create('Sin implementar');
{  if uSemaforoPolenta.sem_wait(FIdSemMutexAcceso) = 0 then
  begin
//    uSemaforoPolenta.setSemVal(FIdSemEstado, 0)
    if (uSemaforoPolenta.sem_signal( FIdSemMutexAcceso ) < 0) then
      raise Exception.Create('TEvent.Signal: Error liberando el mutex de acceso al estado, errno= ' + IntToStr(errno));
  end
  else
    raise Exception.Create('TEvent.Signal: Error esperando por mutex de acceso al estado, errno= ' + IntToStr(errno));}
end;

procedure TEvent.Reset;
begin
  raise exception.Create('Sin implementar');
{  if uSemaforoPolenta.sem_wait(FIdSemMutexAcceso) = 0 then
  begin
//    uSemaforoPolenta.setSemVal(FIdSemEstado, 1)
    if (uSemaforoPolenta.sem_signal( FIdSemMutexAcceso ) < 0) then
      raise Exception.Create('TEvent.Reset: Error liberando el mutex de acceso al estado, errno= ' + IntToStr(errno));
  end
  else
    raise Exception.Create('TEvent.Reset: Error esperando por mutex de acceso al estado, errno= ' + IntToStr(errno));}
end;

function TEvent.Wait(TimeOut: Integer): Boolean;
var
  estado: Integer;
begin
  //Manejar los timeouts

  raise exception.Create('Sin implementar');
  if uSemaforoPolenta.sem_wait(FIdSemMutexWait) = 0 then
  begin
  {  if uSemaforoPolenta.sem_wait(FIdSemMutexAcceso) = 0 then
    begin
      estado:= uSemaforoPolenta.getSemVal(FIdSemEstado);
      if (uSemaforoPolenta.sem_signal( FIdSemMutexAcceso ) < 0) then
        raise Exception.Create('TEvent.Wait: Error liberando el mutex de acceso al estado, errno= ' + IntToStr(errno));

  //  if estado = 1 then
      begin

      end
    end
    else
      raise Exception.Create('TEvent.Wait: Error esperando por mutex de acceso al estado, errno= ' + IntToStr(errno));}
  end
  else
    raise Exception.Create('TEvent.Wait: Error esperando por mutex de wait, errno= ' + IntToStr(errno));
end;

procedure TEvent.Free;
begin
  uSemaforoPolenta.sem_close(FIdSemEstado);
  uSemaforoPolenta.sem_close(FIdSemMutexAcceso);
  uSemaforoPolenta.sem_close(FIdSemMutexWait);
  inherited Free;
end;*)

{  TEvent  }
constructor TEventRX.Create(
   claveStr: string; codigo: integer );
var
  key: key_t;
  s: string;
begin
  inherited create;
  s:=  claveStr+#0;
  key:= ftok( @s[1], codigo );
  if (key = key_t(-1)) then
  begin
    writeln('TEventRX.Create, Problemas con ftok ( '+claveStr+', ', codigo, ')');
  	exit;   //* probably an ftok() error by caller */
  end;

  FSemID := uSemaforoPolenta.sem_createNew(key, 0);
  if FSemID < 0 then
    err_sys('TEventRX.Create->ERR ' + IntToStr(errno) + ', ' + strerror(errno));
  Estado:= 1;
end;

function TEventRX.Wait( ms: integer ): boolean;
begin
  try
    if uSemaforoPolenta.sem_timedwait( FSemId, ms ) < 0 then
      result:= false
    else
    begin
      estado:= 1;
      result:= true; // hasta que implemente
    end;
  except
    err_sys('TEventRX.Wait->ERR ' + IntToStr(errno) + ', ' + strerror(errno));
    result:= false;
  end;
end;

procedure TEventRX.Free;
begin
  uSemaforoPolenta.sem_rm(FSemId );
  inherited Free;
end;

{ TEventTX --------------------------}
{  TEvent  }
constructor TEventTX.Create(
   claveStr: string; codigo: integer );
var
	key: key_t;
  s: string;
begin
  inherited create;
  Estado:= -1;
  s:=  claveStr+#0;
  key:= ftok( @s[1], codigo );

  if (key = key_t(-1)) then
  begin
	  writeln('TEventTX, Problemas con ftok ( '+claveStr+', ', codigo, ')');
	  exit;   //* probably an ftok() error by caller */
  end;

  FSemID := uSemaforoPolenta.sem_open(key);
  if FSemID < 0 then
  begin
    err_sys('TEventTX.Create->ERR ' + IntToStr(errno) + ', ' + strerror(errno));
	  writeln(' No puede abrir el semáforo en TEvenTX.create ');
	  //Estado:= -1;
  end
  else
	  Estado:= 1;
end;


procedure TEventTX.signal;
begin
	if Estado = 1 then
		uSemaforoPolenta.sem_signal( FSemId )
end;

procedure TEventTX.Free;
begin
	if Estado= 1 then
	  try
		  uSemaforoPolenta.sem_close(FSemId );
	  except
		 // el receptor eliminó el semáforo todo OK.
	  end;
	inherited Free;
end;

{  Mensajes -----------------------------------------}


(*************************************
compartición de memoria *)

const
   AccessMode= 438;

constructor TSharedMem.Create( claveStr: string; MemSize: cardinal; subKey: integer );
var
  Key : Integer;
  ts: string;
begin
	pm:= nil;
  FShmId:= -1;
  YaExistia:= false;

  // create key
  ts:= claveStr+#0;
  Key := ftok ( @ts[1], subKey );
//  writeln( 'KEY : ', integer(key));
  if (key = key_t(-1)) then
  begin
  	writeln('TSharedMem.Create: Problemas con ftok ( '+ClaveStr+', 1 ) ');
	  exit;
  end;

  FShmId := shmget (Key, 0, 0);
  if FShmId < 0 then
  begin
  	YaExistia:= false;
	  FShmId := shmget (Key, MemSize,
		  IPC_CREAT or AccessMode);
  end
  else
	  YaExistia:= true;
  //writeln(' shmget -> FShmId = ',FShmId );
  if FShmId = -1 then exit;

  // attach to shared memory
  pm:= shmat (FShmId, nil, 0);
  if Integer(pm) = -1 then
  begin
	  pm:= nil;
    raise Exception.Create (strerror (errno));
  end;
//  writeln('TSharedMem.Create: FShmId= ', FShmId);
end;

procedure TSharedMem.Free;
begin
//  writeln('TSharedMem.Free: FShmId= ', FShmId);
  if Assigned (pm) then
  begin
	  shmdt (pm);
    pm:= nil;
  end;

  // si fue el creador borra
  if (FShmId > 0) and not YaExistia then
  begin
    if shmctl (FShmId, IPC_RMID, nil) = -1 then
    begin
      writeln('TSharedMem.Free: Error borrando share');
		  raise Exception.Create (strerror (errno));
	  end;
  end;

  inherited Free;
end;

(*************************************)

procedure DoProcesoHijo(
	Apl: string;
	params: array of String);
var
  i, error: Integer;
  paramsPChar, iter: PPChar;
begin
  Apl:= Apl + #0;
  GetMem(paramsPChar, (length(params) + 1) * SizeOf(PChar));
  iter:= paramsPChar;
  for i:= 0 to High(params) do
  begin
    params[i]:= params[i] + #0;
    iter^:= @(params[i][1]);
    inc(iter);
  end;
  iter^:= NIL;
  fpexecv(@Apl[1], paramsPChar);

  //si vuelvo de fpexecv hubo error
  error:= fpgeterrno;
  writeln('uEmuladorWinIPC.DoProcesoHijo: error= ', error, ', ', strError( error ));
//	writeln(' *********** ERROR:::: el resultado de exec fue: ', res );

  freemem( paramsPChar, (length(params) + 1) * SizeOf(PChar) );
  halt;
end;

function fork2: Integer;
var
	pid : Integer;
	status : Integer;
begin
	// init child process
	pid := fpfork();
	result:= pid;
	if pid = -1 then exit;

	if pid = 0 then
	begin
		// in child process - init grandchild
		result := fpfork();
		if result <> 0 then
			// still on child process - exit now
			fpexit(0);
	end
	else
	// in parent process - use waitpit to query for child process
		fpwaitpid(pid,@status,0);
end;

function LanzarApl(
	Apl: string;
	params: array of String): boolean;
var
	forkResult: TPid;
begin
	forkResult:= fork2;
	case forkResult of
	  -1  : writeln('uemuladorwinipc.LanzarApl Error creando proceso hijo con fork2.. ');
	  0   : DoProcesoHijo(Apl, params );
	end;

// ojo, solo estamos chequeando que parece que lo lanzo, si falla al cargar la aplic no sabemos
  result:= forkResult  > 0;
end;

initialization
// writeln('ini-> uEmuladorWinIPC');
end.

