{
    This file is part of the Free Pascal run time library.
    Copyright (c) 1999-2022 by Karoly Balogh and other members of the
    Free Pascal development team

    Amiga style simple ipc

    See the file COPYING.FPC, included in this distribution,
    for details about the copyright.

    This program is distributed in the hope that it will be useful,
    but WITHOUT ANY WARRANTY; without even the implied warranty of
    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.

 **********************************************************************}

{$DEFINE OSNEEDIPCINITDONE}

{$IFDEF FPC_DOTTEDUNITS}
uses
  Amiga.Core.Exec, TP.DOS;
{$ELSE FPC_DOTTEDUNITS}
uses
  Exec, dos;
{$ENDIF FPC_DOTTEDUNITS}

ResourceString
  SErrMsgPortExists = 'MsgPort already exists: %s';

const
  PORTNAMESTART = 'fpc_';

Var
  MsgPorts: Classes.TList;

procedure AddMsgPort(AMsgPort: PMsgPort);
begin
  if Assigned(MsgPorts) then
  begin
    MsgPorts.Add(AMsgPort);
  end;
end;

procedure RemoveMsgPort(AMsgPort: PMsgPort);
var
  Idx: Integer;
begin
  if Assigned(MsgPorts) then
  begin
    Idx := MsgPorts.IndexOf(AMsgPort);
    if Idx >= 0 then
    begin
      MsgPorts.Delete(Idx);
      if Assigned(AMsgPort^.mp_Node.ln_Name) and (string(AMsgPort^.mp_Node.ln_Name) <> '') and Assigned(FindPort(AMsgPort^.mp_Node.ln_Name)) then
        RemPort(AMsgPort);
      DeleteMsgPort(AMsgPort);
    end;  
  end;
end;


procedure IPCInit;
begin
  MsgPorts := Classes.TList.Create;
end;

procedure IPCDone;
var
  I: integer;
begin
  try
    for i := 0 to MsgPorts.Count - 1 do
        RemoveMsgPort(PMsgPort(MsgPorts[i]));
    finally  
      FreeAndNil(MsgPorts);  
    end;  
end;


Type
  TAmigaClientComm = Class(TIPCClientComm)
  Private
    FMsgPort: PMsgPort;
    FPortName: String;
  Public
    Constructor Create(AOwner: TSimpleIPCClient); override;
    Procedure Connect; override;
    Procedure Disconnect; override;
    Procedure SendMessage(MsgType : TMessageType; AStream : TStream); override;
    Function  ServerRunning : Boolean; override;
  end;

  TAmigaServerComm = Class(TIPCServerComm)
  Private
    FMsgPort: PMsgPort;
    FPortName: String;
    MsgBody: PMessage;
  Public
    Constructor Create(AOwner: TSimpleIPCServer); override;
    destructor Destroy; override;
    Procedure StartServer; override;
    Procedure StopServer; override;
    Function  PeekMessage(TimeOut : Integer) : Boolean; override;
    Procedure ReadMessage ; override;
    Function GetInstanceID : String;override;
  end;
  
// ####### CLIENT  
  
function SafePutToPort(Msg: PMessage; Portname: string): Boolean;
 var
   Port: PMsgPort;
   PName: PAnsiChar;
 begin
   Result := False;
   PName := PAnsiChar(Portname + #0);
   Forbid();
   Port := FindPort(PName);
   if Assigned(Port) then
   begin
     if Assigned(Msg) then
       PutMsg(Port, Msg);
     Result := True;
   end;
   Permit();
 end;

Constructor TAmigaClientComm.Create(AOwner: TSimpleIPCClient);
begin
  inherited;
end;

Procedure TAmigaClientComm.Connect;
begin
 
end;

Procedure TAmigaClientComm.Disconnect;
begin
  
end;

Procedure TAmigaClientComm.SendMessage(MsgType : TMessageType; AStream : TStream);
var
  Size: Integer;
  FullSize: Integer;
  Memory: Pointer;
  Temp: PByte;
  MsgHead: Exec.PMessage;
  MP: PMsgPort;
  PortName: string;
begin
  Size := AStream.Size - AStream.Position;
  FullSize := Size + SizeOf(TMessageType) + Sizeof(Exec.TMessage);
  PortName := PORTNAMESTART + Owner.ServerID;
  Memory := System.AllocMem(FullSize);
  MP := CreateMsgPort;
  try
    MsgHead := Memory;
    MsgHead^.mn_ReplyPort := MP;
    MsgHead^.mn_Length := Size;
    Temp := Memory;
    Inc(Temp, SizeOf(Exec.TMessage));
    Move(MsgType, Temp^, SizeOf(TMessageType));
    Inc(Temp, SizeOf(TMessageType));
    AStream.Read(Temp^, Size);
    if SafePutToPort(MsgHead, PortName) then
      WaitPort(MP);
  finally
    System.FreeMem(Memory);
    DeleteMsgPort(MP);
  end;
end;

Function TAmigaClientComm.ServerRunning : Boolean;
begin
  Result := SafePutToPort(nil, PORTNAMESTART + Owner.ServerID); 
end;

// ###### SERVER

Constructor TAmigaServerComm.Create(AOwner: TSimpleIPCServer);
begin
  inherited;
  FMsgPort := CreateMsgPort;
  AddMsgPort(FMsgPort);
  MsgBody := nil;
end;

destructor TAmigaServerComm.Destroy;
begin
  if Assigned(MsgBody) then
    System.FreeMem(MsgBody);
  RemoveMsgPort(FMsgPort);
  inherited;
end;

Procedure TAmigaServerComm.StartServer;
begin
  FPortName := PORTNAMESTART + Owner.ServerID + #0;
  if Assigned(FindPort(PAnsiChar(FPortName))) then
  begin
    DoError(SErrMsgPortExists,[FPortName]);
    Exit;
  end;
  FMsgPort^.mp_Node.ln_Name := PAnsiChar(FPortName);
  FMsgPort^.mp_Node.ln_Pri := 0;
  AddPort(FMsgPort);
  if Assigned(MsgBody) then
    System.FreeMem(MsgBody); 
  MsgBody := nil;
end;

Procedure TAmigaServerComm.StopServer;
begin
  RemPort(FMsgPort);
  if Assigned(MsgBody) then
    System.FreeMem(MsgBody);
  MsgBody := nil;
end;

Function TAmigaServerComm.PeekMessage(TimeOut : Integer) : Boolean;
var
  Msg: PMessage;
  Temp: PByte;
  StartTime: Int64;
begin
  StartTime := GetMsCount;
  Result := False;
  if TimeOut < 0 then
    TimeOut := MaxInt;
  repeat
    Msg := GetMsg(FMsgPort);
    if Assigned(Msg) then
    begin
      Result := True;
      Temp := PByte(Msg);
      Inc(Temp, SizeOf(Exec.TMessage));
      if Assigned(MsgBody) then
        System.FreeMem(MsgBody);
      MsgBody := System.AllocMem(SizeOf(Exec.TMessage) + SizeOf(TMessageType) + Msg^.mn_Length);
      Move(Msg^, MsgBody^, SizeOf(Exec.TMessage) + SizeOf(TMessageType) + Msg^.mn_Length);
      ReplyMsg(Msg);
      break;
    end;
    Sleep(25);
  until GetMsCount - StartTime >= TimeOut;
end;

Procedure TAmigaServerComm.ReadMessage;
var
  Temp: PByte;
  MsgType: TMessageType;
  Msg: TIPCServerMsg;
begin
  if Assigned(MsgBody) then
  begin
    Temp := Pointer(MsgBody);
    Inc(Temp, SizeOf(Exec.TMessage));
    MsgType := 0;
    Move(Temp^, MsgType, SizeOf(TMessageType));
    Inc(Temp, SizeOf(TMessageType));

    Msg := TIPCServerMsg.Create;
    try
      Msg.MsgType := MsgType;
      Msg.Stream.WriteBuffer(Temp^, MsgBody^.mn_Length);
    except
      FreeAndNil(Msg);
      raise;
    end;
    PushMessage(Msg);

    System.FreeMem(MsgBody);
    MsgBody := nil;
  end;
end;

Function TAmigaServerComm.GetInstanceID: String;
begin
  Result := HexStr(FindTask(nil));
end;

// ###### Register

Function TSimpleIPCServer.CommClass : TIPCServerCommClass;
begin
  Result:=TAmigaServerComm;
end;

function TSimpleIPCClient.CommClass: TIPCClientCommClass;
begin
  Result:=TAmigaClientComm;
end;

