ssfpc.pas

Synapse The synchronyous socket library. File content: 1.) About Synapse 2.) Distribution pa

end;

function IN6_IS_ADDR_MULTICAST(const a: PInAddr6): boolean;
begin
  Result := (a^.u6_addr8[0] = $FF);
end;

function IN6_ADDR_EQUAL(const a: PInAddr6; const b: PInAddr6): boolean;
begin
  Result := (CompareMem( a, b, sizeof(TInAddr6)));
end;

procedure SET_IN6_IF_ADDR_ANY (const a: PInAddr6);
begin
  FillChar(a^, sizeof(TInAddr6), 0);
end;

procedure SET_LOOPBACK_ADDR6 (const a: PInAddr6);
begin
  FillChar(a^, sizeof(TInAddr6), 0);
  a^.u6_addr8[15] := 1;
end;

{=============================================================================}

function WSAStartup(wVersionRequired: Word; var WSData: TWSAData): Integer;
begin
  with WSData do
  begin
    wVersion := wVersionRequired;
    wHighVersion := $202;
    szDescription := 'Synsock - Synapse Platform Independent Socket Layer';
    szSystemStatus := 'Running on Unix/Linux by FreePascal';
    iMaxSockets := 32768;
    iMaxUdpDg := 8192;
  end;
  Result := 0;
end;

function WSACleanup: Integer;
begin
  Result := 0;
end;

function WSAGetLastError: Integer;
begin
  Result := fpGetErrno; 
end;

function FD_ISSET(Socket: TSocket; var fdset: TFDSet): Boolean;
begin
  Result := fpFD_ISSET(socket, fdset) <> 0;
end;

procedure FD_SET(Socket: TSocket; var fdset: TFDSet);
begin
  fpFD_SET(Socket, fdset);
end;

procedure FD_CLR(Socket: TSocket; var fdset: TFDSet);
begin
  fpFD_CLR(Socket, fdset);
end;

procedure FD_ZERO(var fdset: TFDSet);
begin
  fpFD_ZERO(fdset);
end;

{=============================================================================}

function SizeOfVarSin(sin: TVarSin): integer;
begin
  case sin.sin_family of
    AF_INET:
            Result := SizeOf(TSockAddrIn);
    AF_INET6:
            Result := SizeOf(TSockAddrIn6);
  else
    Result := 0;
  end;
end;

{=============================================================================}

function Bind(s: TSocket; const addr: TVarSin): Integer;
begin
  if sockets.Bind(s, addr, SizeOfVarSin(addr)) then
    Result := 0
  else
    Result := SOCKET_ERROR;
end;

function Connect(s: TSocket; const name: TVarSin): Integer;
begin
  if sockets.Connect(s, name, SizeOfVarSin(name)) then
    Result := 0
  else
    Result := SOCKET_ERROR;
end;

function GetSockName(s: TSocket; var name: TVarSin): Integer;
var
  len: integer;
begin
  len := SizeOf(name);
  FillChar(name, len, 0);
  Result := sockets.GetSocketName(s, name, Len);
end;

function GetPeerName(s: TSocket; var name: TVarSin): Integer;
var
  len: integer;
begin
  len := SizeOf(name);
  FillChar(name, len, 0);
  Result := sockets.GetPeerName(s, name, Len);
end;

function GetHostName: string;
begin
  Result := unix.GetHostName;
end;

function Send(s: TSocket; Buf: TMemory; len, flags: Integer): Integer;
begin
  Result := sockets.Send(s, Buf^, len, flags);
end;

function Recv(s: TSocket; Buf: TMemory; len, flags: Integer): Integer;
begin
  Result := sockets.Recv(s, Buf^, len, flags);
end;

function SendTo(s: TSocket; Buf: TMemory; len, flags: Integer; addrto: TVarSin): Integer;
begin
  Result := sockets.SendTo(s, Buf^, len, flags, addrto, SizeOfVarSin(addrto));
end;

function RecvFrom(s: TSocket; Buf: TMemory; len, flags: Integer; var from: TVarSin): Integer;
var
  x: integer;
begin
  x := SizeOf(from);
  Result := sockets.RecvFrom(s, Buf^, len, flags, from, x);
end;

function Accept(s: TSocket; var addr: TVarSin): TSocket;
var
  x: integer;
begin
  x := SizeOf(addr);
  Result := sockets.Accept(s, addr, x);
end;

function Shutdown(s: TSocket; how: Integer): Integer;
begin
  Result := sockets.Shutdown(s, how);
end;

function SetSockOpt(s: TSocket; level, optname: Integer; optval: Tmemory;
  optlen: Integer): Integer;
begin
  Result := sockets.SetSocketOptions(s, level, optname, optval^, optlen);
end;

function GetSockOpt(s: TSocket; level, optname: Integer; optval: Tmemory;
  var optlen: Integer): Integer;
begin
  Result := sockets.GetSocketOptions(s, level, optname, optval^, optlen);
end;

function  ntohs(netshort: word): word;
begin
  Result := sockets.ntohs(NetShort);
end;

function  ntohl(netlong: longword): longword;
begin
  Result := sockets.ntohl(NetLong);
end;

function  Listen(s: TSocket; backlog: Integer): Integer;
begin
  if sockets.Listen(s, backlog) then
    Result := 0
  else
    Result := SOCKET_ERROR;
end;

function  IoctlSocket(s: TSocket; cmd: DWORD; var arg: integer): Integer;
begin
  Result := fpIoctl(s, cmd, @arg);
end;

function  htons(hostshort: word): word;
begin
  Result := sockets.htons(Hostshort);
end;

function  htonl(hostlong: longword): longword;
begin
  Result := sockets.htonl(HostLong);
end;

function CloseSocket(s: TSocket): Integer;
begin
  Result := sockets.CloseSocket(s);
end;

function Socket(af, Struc, Protocol: Integer): TSocket;
begin
  Result := sockets.Socket(af, struc, protocol);
end;

function Select(nfds: Integer; readfds, writefds, exceptfds: PFDSet;
  timeout: PTimeVal): Longint;
begin
  Result := fpSelect(nfds, readfds, writefds, exceptfds, timeout);
end;

{=============================================================================}
function IsNewApi(Family: integer): Boolean;
begin
  Result := SockEnhancedApi;
  if not Result then
    Result := (Family = AF_INET6) and SockWship6Api;
end;

function SetVarSin(var Sin: TVarSin; IP, Port: string; Family, SockProtocol, SockType: integer; PreferIP4: Boolean): integer;
var
  TwoPass: boolean;
  f1, f2: integer;
  
  function GetAddr(f:integer): integer;
  var
    a4: array [1..1] of in_addr;
    a6: array [1..1] of Tin6_addr;
  begin
    Result := WSAEPROTONOSUPPORT;
    case f of
      AF_INET:
        begin
          a4[1].s_addr := 0;
          Result := WSAHOST_NOT_FOUND;
          a4[1] := StrTonetAddr(IP);
          if a4[1].s_addr = INADDR_ANY then
            Resolvename(ip, a4);
          if a4[1].s_addr <> INADDR_ANY then
          begin
            Sin.sin_family := AF_INET;
            sin.sin_addr := a4[1];
            Result := 0;
          end;
        end;
      AF_INET6:
        begin
          Result := WSAHOST_NOT_FOUND;
          SET_IN6_IF_ADDR_ANY(@a6[1]);
          a6[1] := StrTonetAddr6(IP);
          if IN6_IS_ADDR_UNSPECIFIED(@a6[1]) then
            Resolvename6(ip, a6);
          if IN6_IS_ADDR_UNSPECIFIED(@a6[1]) then
          begin
            Sin.sin_family := AF_INET6;
            sin.sin6_addr := a6[1];
            Result := 0;
          end;
        end;
    end;
  end;
begin
  Result := 0;
  FillChar(Sin, Sizeof(Sin), 0);
  Sin.sin_port := Resolveport(port, family, SockProtocol, SockType);
  TwoPass := False;
  if Family = AF_UNSPEC then
  begin
    if PreferIP4 then
    begin
      f1 := AF_INET;
      f2 := AF_INET6;
      TwoPass := True;
    end
    else
    begin
      f2 := AF_INET;
      f1 := AF_INET6;
      TwoPass := True;
    end;
  end
  else
    f1 := Family;
  Result := GetAddr(f1);
  if Result <> 0 then
    if TwoPass then
      Result := GetAddr(f2);
end;

function GetSinIP(Sin: TVarSin): string;
begin
  Result := '';
  case sin.AddressFamily of
    AF_INET:
      begin
        result := NetAddrToStr(sin.sin_addr);
      end;
    AF_INET6:
      begin
        result := NetAddrToStr6(sin.sin6_addr);
      end;
  end;
end;

function GetSinPort(Sin: TVarSin): Integer;
begin
  if (Sin.sin_family = AF_INET6) then
    Result := synsock.ntohs(Sin.sin6_port)
  else
    Result := synsock.ntohs(Sin.sin_port);
end;

procedure ResolveNameToIP(Name: string; Family, SockProtocol, SockType: integer; const IPList: TStrings);
var
  x, n: integer;
  a4: array [1..255] of in_addr;
  a6: array [1..255] of Tin6_addr;
begin
  IPList.Clear;
  if (family = AF_INET) or (family = AF_UNSPEC) then
  begin
    a4[1] := StrTonetAddr(name);
    if a4[1].s_addr = INADDR_ANY then
      x := Resolvename(name, a4)
    else
      x := 1;
    for n := 1  to x do
      IpList.Add(netaddrToStr(a4[n]));
  end;

  if (family = AF_INET6) or (family = AF_UNSPEC) then
  begin
    a6[1] := StrTonetAddr6(name);
    if IN6_IS_ADDR_UNSPECIFIED(@a6[1]) then
      x := Resolvename6(name, a6)
    else
      x := 1;
    for n := 1  to x do
      IpList.Add(netaddrToStr6(a6[n]));
  end;
  
  if IPList.Count = 0 then
    IPList.Add(cAnyHost);
end;

function ResolvePort(Port: string; Family, SockProtocol, SockType: integer): Word;
var
  ProtoEnt: TProtocolEntry;
  ServEnt: TServiceEntry;
begin
  Result := synsock.htons(StrToIntDef(Port, 0));
  if Result = 0 then
  begin
    ProtoEnt.Name := '';
    GetProtocolByNumber(SockProtocol, ProtoEnt);
    ServEnt.port := 0;
    GetServiceByName(Port, ProtoEnt.Name, ServEnt);
    Result := ServEnt.port;  
  end;
end;

function ResolveIPToName(IP: string; Family, SockProtocol, SockType: integer): string;
var
  n: integer;
  a4: array [1..1] of in_addr;
  a6: array [1..1] of Tin6_addr;
  a: array [1..1] of string;
begin
  Result := IP;
  a4[1] := StrToNetAddr(IP);
  if a4[1].s_addr <> INADDR_ANY then
  begin
//why ResolveAddress need address in HOST order? :-O 
    n := ResolveAddress(nettohost(a4[1]), a);
    if n > 0 then
      Result := a[1];
  end
  else
  begin
    a6[1] := StrToNetAddr6(IP);
    n := ResolveAddress6(a6[1], a);
    if n > 0 then
      Result := a[1];
  end;
end;

{=============================================================================}

function InitSocketInterface(stack: string): Boolean;
begin
  SockEnhancedApi := False;
  SockWship6Api := False;
//  Libc.Signal(Libc.SIGPIPE, TSignalHandler(Libc.SIG_IGN));
  Result := True;
end;

function DestroySocketInterface: Boolean;
begin
  Result := True;
end;

initialization
begin
  SynSockCS := SyncObjs.TCriticalSection.Create;
  SET_IN6_IF_ADDR_ANY (@in6addr_any);
  SET_LOOPBACK_ADDR6  (@in6addr_loopback);
end;

finalization
begin
  SynSockCS.Free;
end;

{$ENDIF}