program removeIPCs;

{$APPTYPE CONSOLE}

uses
  Classes,
  Sysutils,
{$IFDEF LINUX}
  ipc,
  baseunix,
  ipcobjs in '..\..\..\src_libnettopos\fctopos\IPC\Linux\ipcobjs.pas',
{$ENDIF}
  strutils;

const
	 Separadores= [' ', ',', ';', #9, #10, #13];

type
  TSharedMemLine = class
    public
      key: longint;
      shmid, bytes, nattch: Integer;
      owner, perms, status: String;

      Constructor Create(key: longint; shmid: Integer; owner, perms: String; nBytes, nAttached: Integer; status: String);
  end;

  TSemaphoreLine = class
    public
      key: longint;
      semid, nsems: Integer;
      owner, perms: String;

      Constructor Create(key: longint; semid: Integer; owner, perms: String; nsems: Integer);
  end;

  TMsgQueueLine = class
    public
      key: longint;
      msqid, usedbytes, messages: Integer;
      owner, perms, status: String;

      Constructor Create(key: longint; msqid: Integer; owner, perms: String; usedbytes, messages: Integer);
  end;

Constructor TSharedMemLine.Create(key: longint; shmid: Integer; owner, perms: String; nBytes, nAttached: Integer; status: String);
begin
  inherited Create;
  self.key:= key;
  self.shmid:= shmid;
  self.owner:= owner;
  self.perms:= perms;
  self.bytes:= nBytes;
  self.nattch:= nAttached;
  self.status:= status;
end;

Constructor TSemaphoreLine.Create(key: longint; semid: Integer; owner, perms: String; nsems: Integer);
begin
  inherited Create;
  self.key:= key;
  self.semid:= semid;
  self.owner:= owner;
  self.perms:= perms;
  self.nsems:= nsems;
end;

Constructor TMsgQueueLine.Create(key: longint; msqid: Integer; owner, perms: String; usedbytes, messages: Integer);
begin
  inherited Create;
  self.key:= key;
  self.msqid:= msqid;
  self.owner:= owner;
  self.perms:= perms;
  self.usedbytes:= usedbytes;
  self.messages:= messages;
end;

function NextPal(var s: string ):string;
var
	k1, k2: integer;
	ts: string;
begin
	k1:= 1;
	while (k1<= Length(s)) and (s[k1] in Separadores ) do inc(k1);
  k2:= k1;
	while (k2<= Length(s)) and not(s[k2] in Separadores) do inc(k2);
  ts:= copy(s, k1, k2-k1);
  delete(s, 1, k2);
	result:= ts;
end;

var
  listaShm, listaSems, listaQueues: TList;
  lineasArchi: TStringList;
  i: Integer;

  linea: String;
  key: longint;
  keyAsString: String;
  shmid, semid, nsems, bytes, nattch, usedbytes, messages: Integer;
  owner, perms, status: String;

  usuarioActual: String;
  lineaSharedMem: TSharedMemLine;
  lineaSem: TSemaphoreLine;
  lineaMsgQueue: TMsgQueueLine;
  semctl_arg: TVSemUnion;
begin
  if ParamCount = 1 then
  begin
    if FileExists(ParamStr(1)) then
    begin
      lineasArchi:= TStringList.Create;
      lineasArchi.LoadFromFile(ParamStr(1));

      i:= 0;
      while (i < lineasArchi.Count) and (lineasArchi[i] <> '------ Shared Memory Segments --------') do
        i:= i + 1;
      i:= i + 2;

      listaShm:= TList.Create;
      //Cargo shared mems
      while (i < lineasArchi.Count) and (lineasArchi[i] <> '') do
      begin
        linea:= lineasArchi[i];
        keyAsString:= NextPal(linea);
        delete(keyAsString, 1, 2);
        key:= Hex2Dec(keyAsString);
        shmid:= StrToInt(NextPal(linea));
        owner:= NextPal(linea);
        perms:= NextPal(linea);
        bytes:= StrToInt(NextPal(linea));
        nattch:= StrToInt(NextPal(linea));
        status:= NextPal(linea);
        listaShm.Add(TSharedMemLine.Create(key, shmid, owner, perms, bytes, nattch, status));
        i:= i + 1;
      end;

      while (i < lineasArchi.Count) and (lineasArchi[i] <> '------ Semaphore Arrays --------') do
        i:= i + 1;
      i:= i + 2;

      listaSems:= TList.Create;
      //Cargo sems
      while (i < lineasArchi.Count) and (lineasArchi[i] <> '') do
      begin
        linea:= lineasArchi[i];
        keyAsString:= NextPal(linea);
        delete(keyAsString, 1, 2);
        key:= Hex2Dec(keyAsString);
        semid:= StrToInt(NextPal(linea));
        owner:= NextPal(linea);
        perms:= NextPal(linea);
        nsems:= StrToInt(NextPal(linea));
        listaSems.Add(TSemaphoreLine.Create(key, semid, owner, perms, nsems));
        i:= i + 1;
      end;

      while (i < lineasArchi.Count) and (lineasArchi[i] <> '------ Message Queues --------') do
        i:= i + 1;
      i:= i + 2;      

      listaQueues:= TList.Create;
      //Cargo message queues
      while (i < lineasArchi.Count) and (lineasArchi[i] <> '') do
      begin
        linea:= lineasArchi[i];
        keyAsString:= NextPal(linea);
        delete(keyAsString, 1, 2);
        key:= Hex2Dec(keyAsString);
        shmid:= StrToInt(NextPal(linea));
        owner:= NextPal(linea);
        perms:= NextPal(linea);
        usedbytes:= StrToInt(NextPal(linea));
        messages:= StrToInt(NextPal(linea));
        listaQueues.Add(TMsgQueueLine.Create(key, shmid, owner, perms, usedbytes, messages));
        i:= i + 1;
      end;

      lineasArchi.Free;

      usuarioActual:= fpgetenv('USER');
      if usuarioActual = '' then
        usuarioActual:= fpgetenv('LOGNAME');
      if usuarioActual = '' then
        raise Exception.Create('Error obteniendo usuario actual');

      //liberar shared mems
      for i:= 0 to listaShm.Count - 1 do
      begin
        lineaSharedMem:= listaShm[i];
        if (lineaSharedMem.owner = usuarioActual) and
           (lineaSharedMem.nattch = 0) then
        begin
          if shmctl(lineaSharedMem.shmid, IPC_RMID, nil) = -1 then
            writeln('Error eliminando sharedmem shmid= ', lineaSharedMem.shmid)
          else
            writeln('Shared mem borrado shmid= ', lineaSharedMem.shmid);
        end;
        lineaSharedMem.Free;
      end;
      listaShm.Free;

      //liberar sems
      for i:= 0 to listaSems.Count - 1 do
      begin
        lineaSem:= listaSems[i];
        if (lineaSem.owner = usuarioActual) then
        begin
          if semctl(lineaSem.semid, 0, IPC_RMID, semctl_arg ) < 0 then
            writeln('Error eliminando semaforo semid= ', lineaSem.semid)
          else
            writeln('Semaforo borrado semid= ', lineaSem.semid);
        end;
        lineaSem.Free;
      end;
      listaSems.Free;

      //liberar msgQueues
      for i:= 0 to listaQueues.Count - 1 do
      begin
        lineaMsgQueue:= listaQueues[i];
        if (lineaMsgQueue.owner = usuarioActual) then
        begin
          if msgctl(lineaMsgQueue.msqid, IPC_RMID, NIL) < 0 then
            writeln('Error eliminando msgqueue msqid= ', lineaMsgQueue.msqid)
          else
            writeln('Msgqueue borrada msqid= ', lineaMsgQueue.msqid);
        end;
        lineaMsgQueue.Free;
      end;
      listaQueues.Free;                                
    end
    else
      writeln('No se encuentra el archivo ', ParamStr(1));
  end
  else
  begin
    writeln('Uso:');
    writeln('premoveIPCs archiIPCs');
  end;
end.
