Browse Source

Adding fpsockets unit to fcl-net

Frederic Kehrein 10 months ago
parent
commit
dcabb0151f

+ 1 - 0
packages/fcl-net/fpmake.pp

@@ -42,6 +42,7 @@ begin
     P.IncludePath.Add('src/$(OS)',AllOSes-AllWindowsOSes-AllUnixOSes-[EMX]);
     P.IncludePath.Add('src/$(OS)',AllOSes-AllWindowsOSes-AllUnixOSes-[EMX]);
 
 
     // IP and Sockets
     // IP and Sockets
+    T:=P.Targets.AddUnit('fpsockets.pp',AllUnixOSes+AllWindowsOSes);
     T:=P.Targets.AddUnit('netdb.pp',AllUnixOSes);
     T:=P.Targets.AddUnit('netdb.pp',AllUnixOSes);
     T:=P.Targets.AddUnit('sslbase.pp');
     T:=P.Targets.AddUnit('sslbase.pp');
     T:=P.Targets.AddUnit('resolve.pp',AllUnixOSes+AllWindowsOSes+AllAmigaLikeOSes+[OS2,EMX]);
     T:=P.Targets.AddUnit('resolve.pp',AllUnixOSes+AllWindowsOSes+AllAmigaLikeOSes+[OS2,EMX]);

+ 1062 - 0
packages/fcl-net/src/fpsockets.pp

@@ -0,0 +1,1062 @@
+{
+    This file is part of the Free Component Library (FCL)
+    Copyright (c) 2024 by Frederic Kehrein
+
+    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.
+
+ **********************************************************************}
+
+{$IFNDEF FPC_DOTTEDUNITS}
+unit fpsockets;
+{$ENDIF FPC_DOTTEDUNITS}
+
+{$mode ObjFPC}{$H+}
+{$TypedAddress on}
+
+interface
+
+{$IFDEF FPC_DOTTEDUNITS}
+uses
+  System.SysUtils, System.Net.Sockets, SystemNullable;
+{$ELSE FPC_DOTTEDUNITS}
+uses
+  sysutils, sockets, nullable;
+{$ENDIF FPC_DOTTEDUNITS}
+
+type
+
+  { Basic Socket Types }
+
+  TFPSocketType = (stIPv4, stIPv6, stIPDualStack, stUnixSocket);
+  TFPSocketProto = (spStream, spDatagram);
+  TFPSocket = record
+    FD: TSocket;
+    Protocol: TFPSocketProto;
+    SocketType: TFPSocketType;
+  end;
+
+  TAddressType = (atIN4, atIN6, atUnixSock);
+  TNetworkAddress = record
+    Address: String;
+    AddressType: TAddressType;
+  end;
+
+  TFPSocketConnection = record
+    ClientAddress: TNetworkAddress;
+    ClientPort: Word;
+    Socket: TFPSocket;
+  end;
+
+  { ReceiveFrom Return Types }
+
+  TReceiveFromResult = record
+    FromAddr: TNetworkAddress;
+    FromPort: Word;
+    DataSize: SizeInt;
+  end;
+
+  generic TReceiveFromMessage<T> = record
+    FromAddr: TNetworkAddress;
+    FromPort: Word;
+    Data: T;
+  end;
+
+  TReceiveFromStringMessage = specialize TReceiveFromMessage<String>;
+
+  { State Management }
+
+  TConnectionState = (csError, csNotConnected, csRefused, csPending, csConnected);
+
+  { Exceptions }
+
+  EDualStackNotSupported = class(Exception);
+  EUnsupportedAddress = class(Exception);
+
+  { ESocketError }
+
+  ESocketError = class(Exception)
+  private
+    FCode: Integer;
+  public
+    constructor Create(ACode: Integer; const FunName: String);
+
+    property Code: Integer read FCode;
+  end;
+
+  EConnectionClosedException = class(Exception);
+
+  { EFragmentedData }
+
+  EFragmentedData = class(Exception)
+  private
+    FFragment: TBytes;
+    FExpectedSize: SizeInt;
+  public
+    constructor Create(const AFragment: TBytes; AExpected: SizeInt; const AMessage: String);
+
+    property Fragment: TBytes read FFragment;
+    property ExpectedSize: SizeInt read FExpectedSize;
+  end;
+
+const
+  MaxUDPPackageSize = 512;
+
+  { Address Management }
+
+function isIPv4Address(const Address: String): Boolean; inline;
+function isIPv6Address(const Address: String): Boolean; inline;
+
+function IN4Address(const Address: String): TNetworkAddress; inline;
+function IN6Address(const Address: String): TNetworkAddress; inline;
+function IN4MappedIN6Address(const In4Address: String): TNetworkAddress; inline;
+function UnixAddr(const Address: String): TNetworkAddress; inline;
+function NetAddr(const Address: String): TNetworkAddress; inline;
+
+function isINAddr(const AAddr: TNetworkAddress): Boolean; inline;
+function IsIPv4Mapped(const IPv6Addr: TNetworkAddress): Boolean; inline;
+function ExtractIPv4Address(const IPv6Addr: TNetworkAddress): TNetworkAddress; inline;
+
+function IN6Equal(const A, B: String): Boolean;
+operator =(const A, B: TNetworkAddress): Boolean; inline;
+operator <>(const A, B: TNetworkAddress): Boolean; inline;
+operator :=(const AStr: String): TNetworkAddress; inline;
+
+  { Socket Functions }
+
+function TCPSocket(AType: TFPSocketType): TFPSocket; inline;
+function UDPSocket(AType: TFPSocketType): TFPSocket; inline;
+
+procedure CloseSocket(const ASocket: TFPSocket); inline;
+
+procedure Bind(const ASocket: TFPSocket; const AAddress: TNetworkAddress; APort: Word; ReuseAddr: Boolean = True);
+
+procedure Listen(const ASocket: TFPSocket; Backlog: Integer); inline;
+function AcceptConnection(const ASocket: TFPSocket): TFPSocketConnection; inline;
+function AcceptNonBlocking(const ASocket: TFPSocket): specialize TNullable<TFPSocketConnection>; inline;
+
+function Connect(const ASocket: TFPSocket; const AAddress: TNetworkAddress; APort: Word): TConnectionState; inline;
+
+function Receive(const ASocket: TFPSocket; ABuffer: Pointer; MaxSize: SizeInt; AFlags: Integer = 0): SizeInt; inline;
+function ReceiveFrom(const ASocket: TFPSocket; ABuffer: Pointer; MaxSize: SizeInt; AFlags: Integer = 0): TReceiveFromResult;
+function ReceiveFromNonBlocking(const ASocket: TFPSocket; ABuffer: Pointer; MaxSize: SizeInt; AFlags: Integer = 0): specialize TNullable<TReceiveFromResult>; inline;
+function Send(const ASocket: TFPSocket; ABuffer: Pointer; ASize: SizeInt; AFlags: Integer = 0): SizeInt; inline;
+function SendTo(const ASocket: TFPSocket; const ReceiverAddr: TNetworkAddress;
+                  ReceiverPort: Word; ABuffer: Pointer; ASize: SizeInt; AFlags: Integer = 0): SizeInt; inline;
+
+function ReceiveStr(const ASocket: TFPSocket; MaxLength: SizeInt = -1; AFlags: Integer = 0): String;
+function ReceiveStrFrom(const ASocket: TFPSocket; MaxLength: SizeInt = MaxUDPPackageSize; AFlags: Integer = 0): TReceiveFromStringMessage; inline;
+function ReceiveStrFromNonBlocking(const ASocket: TFPSocket; MaxLength: SizeInt = MaxUDPPackageSize; AFlags: Integer = 0): specialize TNullable<TReceiveFromStringMessage>; inline;
+function SendStr(const ASocket: TFPSocket; const AData: String; AFlags: Integer = 0): SizeInt; inline;
+function SendStrTo(const ASocket: TFPSocket; const ReceiverAddr: TNetworkAddress; ReceiverPort: Word; const AData: String; AFlags: Integer = 0): SizeInt; inline;
+
+generic function Receive<T>(const ASocket: TFPSocket; AFlags: Integer = 0): T;
+generic function ReceiveNonBlocking<T>(const ASocket: TFPSocket; AFlags: Integer = 0): specialize TNullable<T>;
+generic function ReceiveFrom<T>(const ASocket: TFPSocket; AFlags: Integer = 0): specialize TReceiveFromMessage<T>;
+generic function ReceiveFromNonBlocking<T>(const ASocket: TFPSocket; AFlags: Integer = 0): specialize TNullable<specialize TReceiveFromMessage<T>>;
+generic function Send<T>(const ASocket: TFPSocket; constref AData: T; AFlags: Integer = 0): SizeInt; inline;
+generic function SendTo<T>(const ASocket: TFPSocket; constref ReceiverAddr: TNetworkAddress; ReceiverPort: Word; const AData: T; AFlags: Integer = 0): SizeInt; inline;
+
+generic function ReceiveArray<T>(const ASocket: TFPSocket; MaxCount: SizeInt = -1; AFlags: Integer = 0): specialize TArray<T>;
+generic function ReceiveArrayFrom<T>(const ASocket: TFPSocket; MaxCount: SizeInt = -1; AFlags: Integer = 0): specialize TReceiveFromMessage<specialize TArray<T>>; inline;
+generic function ReceiveArrayFromNonBlocking<T>(const ASocket: TFPSocket; MaxCount: SizeInt = -1; AFlags: Integer = 0): specialize TNullable<specialize TReceiveFromMessage<specialize TArray<T>>>; inline;
+generic function SendArray<T>(const ASocket: TFPSocket; const AData: specialize TArray<T>; AFlags: Integer = 0): SizeInt; inline;
+generic function SendArrayTo<T>(const ASocket: TFPSocket; const ReceiverAddr: TNetworkAddress; ReceiverPort: Word; const AData: specialize TArray<T>; AFlags: Integer = 0): SizeInt; inline;
+
+  { Socket/Connection State Management }
+
+procedure SetNonBlocking(const ASocket: TFPSocket; AValue: Boolean);
+
+// Timeout in MS
+function DataAvailable(const SocketArray: specialize TArray<TFPSocket>; TimeOut: Integer = 0): specialize TArray<TFPSocket>; overload;
+function DataAvailable(const ASocket: TFPSocket; TimeOut: Integer = 0): Boolean; overload; //inline;
+function DataAvailable(const SocketArray: array of TFPSocket; TimeOut: Integer = 0): specialize TArray<TFPSocket>; overload; inline;
+
+function BytesAvailable(const ASocket: TFPSocket): SizeInt;
+
+function StreamClosed(const ASocket: TFPSocket): Boolean; inline;
+
+// For non blocking connections, connect will return a pending connection that needs to be checked
+// Note: csConnected means that connection was establised at least once
+// If it has been closed by the other side, it is still csConnected, use StreamClosed to figure out
+// if the stream is actually open
+function ConnectionState(const ASocket: TFPSocket): TConnectionState;
+
+implementation
+
+{$IFDEF FPC_DOTTEDUNITS}
+uses
+  {$IfDef WINDOWS}WinApi.WinSock2{$Else}UnixApi.Base, UnixApi.TermIO{$EndIf}, System.Math;
+{$ELSE FPC_DOTTEDUNITS}
+uses
+  {$IfDef WINDOWS}WinSock2{$Else}BaseUnix, termio{$EndIf}, math;
+{$ENDIF FPC_DOTTEDUNITS}
+
+{$macro on}
+{$IFDEF FPC_DOTTEDUNITS}
+{$define socketsunit:=System.Net.Sockets}
+{$ELSE FPC_DOTTEDUNITS}
+{$define socketsunit:=sockets}
+{$ENDIF FPC_DOTTEDUNITS}
+
+{ Helper }
+
+type
+  _PAddressUnion = ^_TAddressUnion;
+  _TAddressUnion = record
+  case TFPSocketType of
+  stIPv4: (In4Addr: socketsunit.sockaddr_in);
+  stIPv6: (In6Addr: socketsunit.sockaddr_in6);
+  stUnixSocket: (UnixAddr: socketsunit.sockaddr_un);
+  end;
+
+const
+  IPPROTO_IPV6 = {$IfDef WINDOWS}41{$Else}41{$EndIf};
+  IPV6_V6ONLY = {$IfDef WINDOWS}27{$Else}26{$EndIf};
+
+function WouldBlock(SockErr: Integer): Boolean; inline;
+begin
+  Result := (SockErr = EsockEWOULDBLOCK)
+            {$IfDef Unix} or (SockErr = ESysEAGAIN) {$EndIf}
+end;
+
+function CreateAddr(AAddress: TNetworkAddress; APort: Word; DualStack: Boolean): _TAddressUnion;
+begin
+  if (AAddress.AddressType = atIN4) and DualStack then
+    AAddress := IN4MappedIN6Address(AAddress.Address);
+  if AAddress.AddressType = atIN4 then
+  begin
+    Result.In4Addr.sin_family := AF_INET;
+    Result.In4Addr.sin_port := HToNS(APort);
+    Result.In4Addr.sin_addr.s_addr := LongWord(StrToNetAddr(AAddress.Address));
+  end
+  else if AAddress.AddressType = atIN6 then
+  begin
+    Result.In6Addr.sin6_family := AF_INET6;
+    Result.In6Addr.sin6_port := HToNS(APort);
+    Result.In6Addr.sin6_addr := StrToHostAddr6(AAddress.Address);
+    Result.In6Addr.sin6_flowinfo := 0;
+    Result.In6Addr.sin6_scope_id := 0;
+  end
+  else if AAddress.AddressType = atUnixSock then
+  begin
+    if Length(AAddress.Address) > SizeOf(Result.UnixAddr.sun_path)-1 then
+      raise EUnsupportedAddress.Create('Unix address should be at most 108 characters');
+    Result.UnixAddr.sun_family := AF_UNIX;
+    FillChar(Result.UnixAddr, SizeOf(Result.UnixAddr), #00);
+    Move(AAddress.Address[1], Result.UnixAddr.sun_path, Length(AAddress.Address));
+  end
+  else
+    raise EUnsupportedAddress.Create('Address type ' + ord(AAddress.AddressType).ToString + ' not supported');
+end;
+
+procedure ReadAddr(constref Addr: _TAddressUnion; DualStack: Boolean; out
+  AAddress: TNetworkAddress; out APort: Word);
+var
+  i:Integer;
+begin
+  if Addr.In4Addr.sin_family = AF_INET then
+  begin
+    AAddress := IN4Address(NetAddrToStr(Addr.In4Addr.sin_addr));
+    APort := NToHs(Addr.In4Addr.sin_port);
+  end
+  else if Addr.In6Addr.sin6_family = AF_INET6 then
+  begin
+    AAddress := IN6Address(HostAddrToStr6(Addr.In6Addr.sin6_addr));
+    if DualStack and IsIPv4Mapped(AAddress.Address) then
+      AAddress := ExtractIPv4Address(AAddress);
+    APort := NToHs(Addr.In6Addr.sin6_port);
+  end
+  else if Addr.In6Addr.sin6_family = AF_INET6 then
+  begin
+    AAddress.AddressType := atUnixSock;
+    SetLength(AAddress.Address, SizeOf(Addr.UnixAddr.sun_path));
+    i:=0;
+    while i < Length(Addr.UnixAddr.sun_path) do
+      if Addr.UnixAddr.sun_path[i+low(Addr.UnixAddr.sun_path)] = #00 then
+        break
+      else
+        AAddress.Address[i+1] := Addr.UnixAddr.sun_path[i+low(Addr.UnixAddr.sun_path)];
+    SetLength(AAddress.Address, i);
+    APort := 0;
+  end
+  else
+    raise EUnsupportedAddress.Create('Address Family ' + Addr.In4Addr.sin_family.ToString + ' not supported');
+end;
+
+function SocketInvalid(ASocket: TSocket): Boolean; inline;
+begin
+  {$IfDef Windows}
+  Result := ASocket = TSocket(INVALID_SOCKET);
+  {$Else}
+  Result := ASocket < 0;
+  {$EndIf}
+end;
+
+function CreateRawSocket(ADomain: TFPSocketType; ASockProto: TFPSocketProto; AProto: Integer): TSocket;
+var
+  AFam, AType, v6Only: Integer;
+begin
+  case ADomain of
+  stIPv4: AFam := AF_INET;
+  stIPv6,
+  stIPDualStack: AFam := AF_INET6;
+  stUnixSocket: AFam := AF_UNIX;
+  end;
+  case ASockProto of
+  spStream: AType := SOCK_STREAM;
+  spDatagram: AType := SOCK_DGRAM;
+  end;
+  Result := fpsocket(AFam, AType, AProto);
+  if SocketInvalid(Result) then
+    raise ESocketError.Create(socketerror, 'socket');
+
+  if ADomain = stIPDualStack then
+  begin
+    v6Only := 0;
+    if fpsetsockopt(Result, IPPROTO_IPV6, IPV6_V6ONLY, @v6Only, SizeOf(v6Only)) <> 0 then
+    begin
+      socketsunit.CloseSocket(Result);
+      raise EDualStackNotSupported.Create('Dualstack option not supported on this system: ' + socketerror.ToString);
+    end;
+  end;
+end;
+
+function isIPv4Address(const Address:String):Boolean;
+var
+  dummy:socketsunit.in_addr;
+begin
+  Result := TryStrToHostAddr(Address, dummy);
+end;
+
+function isIPv6Address(const Address:String):Boolean;
+var
+  dummy:in6_addr;
+begin
+  Result := TryStrToHostAddr6(Address, dummy);
+end;
+
+function IN4Address(const Address: String): TNetworkAddress;
+begin
+ Result := Default(TNetworkAddress);
+ Result.Address := Address;
+ Result.AddressType := atIN4;
+end;
+
+function IN6Address(const Address: String): TNetworkAddress;
+begin
+ Result := Default(TNetworkAddress);
+ Result.Address := Address;
+ Result.AddressType := atIN6;
+end;
+
+function IN4MappedIN6Address(const In4Address: String): TNetworkAddress;
+var
+  InAddr: TIn_addr;
+begin
+  InAddr := StrToNetAddr(In4Address);
+  Result := IN6Address('::FFFF:%x:%x'.Format([(InAddr.s_bytes[1] shl 8) or InAddr.s_bytes[2],
+                                              (InAddr.s_bytes[3] shl 8) or InAddr.s_bytes[4]]));
+end;
+
+function UnixAddr(const Address: String):TNetworkAddress;
+begin
+ Result := Default(TNetworkAddress);
+ Result.Address := Address;
+ Result.AddressType := atUnixSock;
+end;
+
+function NetAddr(const Address: String): TNetworkAddress;
+begin
+ Result := Default(TNetworkAddress);
+  if isIPv4Address(Address) then
+    Result.AddressType := atIN4
+  else if isIPv6Address(Address) then
+    Result.AddressType := atIN6
+  else // Filenames can be pretty much anything
+    Result.AddressType := atUnixSock;
+  Result.Address := Address;
+end;
+
+function IsIPv4Mapped(const IPv6Addr: TNetworkAddress): Boolean;
+var
+  In6Addr: socketsunit.TIn6Addr;
+begin
+  if IPv6Addr.AddressType = atIN4 then
+    Exit(True);
+  if IPv6Addr.AddressType  <> atIN6 then
+    raise EUnsupportedAddress.Create('Can only check IPv4 mapping for IPv6 addresses');
+  IN6Addr := StrToHostAddr6(IPv6Addr.Address);
+  Result := (IN6Addr.u6_addr16[0] = 0) and
+            (IN6Addr.u6_addr16[1] = 0) and
+            (IN6Addr.u6_addr16[2] = 0) and
+            (IN6Addr.u6_addr16[3] = 0) and
+            (IN6Addr.u6_addr16[4] = 0) and
+            (IN6Addr.u6_addr16[5] = $FFFF);
+end;
+
+function isINAddr(const AAddr:TNetworkAddress):Boolean;
+begin
+  Result := AAddr.AddressType in [atIN4, atIN6];
+end;
+
+function ExtractIPv4Address(const IPv6Addr: TNetworkAddress): TNetworkAddress;
+var
+  In6Addr: socketsunit.TIn6Addr;
+begin
+  if IPv6Addr.AddressType = atIN4 then
+    Exit(IPv6Addr);
+  if IPv6Addr.AddressType  <> atIN6 then
+    raise EUnsupportedAddress.Create('Can only extract IPv4 mapping from IPv6 addresses');
+  IN6Addr := StrToHostAddr6(IPv6Addr.Address);
+  Result := IN4Address('%d.%d.%d.%d'.Format([IN6Addr.s6_addr8[12],
+                                             IN6Addr.s6_addr8[13],
+                                             IN6Addr.s6_addr8[14],
+                                             IN6Addr.s6_addr8[15]]));
+end;
+
+function IN6Equal(const A, B: String): Boolean;
+var
+  AAddr, BAddr: socketsunit.Tin6_addr;
+begin
+  AAddr := StrToHostAddr6(A);
+  BAddr := StrToHostAddr6(B);
+  Result := (AAddr.s6_addr32[0] = BAddr.s6_addr32[0]) and
+            (AAddr.s6_addr32[1] = BAddr.s6_addr32[1]) and
+            (AAddr.s6_addr32[2] = BAddr.s6_addr32[2]) and
+            (AAddr.s6_addr32[3] = BAddr.s6_addr32[3]);
+end;
+
+operator=(const A, B: TNetworkAddress): Boolean;
+begin
+  Result := (A.AddressType = B.AddressType) and (
+              ((A.AddressType = atIN4) and (A.Address = B.Address)) or // IPv4: simple string equality
+              ((A.AddressType = atIN6) and IN6Equal(A.Address, B.Address)) or // IPv6 check binary equality
+              ((A.AddressType = atUnixSock) and SameFileName(A.Address, B.Address)) // UnixSock check if filename equals
+            );
+end;
+
+operator<>(const A, B: TNetworkAddress): Boolean;
+begin
+  Result := (A.AddressType <> B.AddressType) or not (
+              ((A.AddressType = atIN4) and (A.Address = B.Address)) or // IPv4: simple string equality
+              ((A.AddressType = atIN6) and IN6Equal(A.Address, B.Address)) or // IPv6 check binary equality
+              ((A.AddressType = atUnixSock) and SameFileName(A.Address, B.Address)) // UnixSock check if filename equals
+            );
+end;
+
+operator:=(const AStr: String): TNetworkAddress;
+begin
+  Result := NetAddr(AStr);
+end;
+
+function TCPSocket(AType: TFPSocketType): TFPSocket;
+begin
+  Result.SocketType := AType;
+  Result.Protocol := spStream;
+  Result.FD := CreateRawSocket(Result.SocketType, Result.Protocol, 0);
+end;
+
+function UDPSocket(AType: TFPSocketType): TFPSocket;
+begin
+  Result.SocketType := AType;
+  Result.Protocol := spDatagram;
+  Result.FD := CreateRawSocket(Result.SocketType, Result.Protocol, 0);
+end;
+
+procedure CloseSocket(const ASocket: TFPSocket);
+begin
+  socketsunit.CloseSocket(ASocket.FD);
+end;
+
+procedure Bind(const ASocket: TFPSocket; const AAddress: TNetworkAddress;
+  APort: Word; ReuseAddr: Boolean);
+var
+  enableReuse: Integer = 1;
+  addr: _TAddressUnion;
+begin
+  if ReuseAddr then
+    fpsetsockopt(ASocket.FD, SOL_SOCKET, SO_REUSEADDR, @enableReuse, SizeOf(enableReuse));
+  addr := CreateAddr(AAddress, APort, ASocket.SocketType = stIPDualStack);
+  if fpbind(ASocket.FD, socketsunit.PSockAddr(@addr), SizeOf(addr)) <> 0 then raise
+    ESocketError.Create(socketerror, 'bind (%s:%d)'.Format([AAddress.Address, APort]));
+end;
+
+procedure Listen(const ASocket: TFPSocket; Backlog: Integer);
+begin
+  if fplisten(ASocket.FD, Backlog) <> 0 then raise
+    ESocketError.Create(socketerror, 'listen');
+end;
+
+function AcceptConnection(const ASocket: TFPSocket): TFPSocketConnection;
+var
+  addr: _TAddressUnion;
+  addrLen: TSocklen = SizeOf(addr);
+begin
+  Result.Socket.FD := fpaccept(ASocket.FD, socketsunit.psockaddr(@addr), @addrLen);
+  if SocketInvalid(Result.Socket.FD) then
+    raise ESocketError.Create(socketerror, 'accept');
+  Result.Socket.SocketType := ASocket.SocketType;
+  Result.Socket.Protocol := ASocket.Protocol;
+  ReadAddr(addr, ASocket.SocketType = stIPDualStack, Result.ClientAddress, Result.ClientPort);
+end;
+
+function AcceptNonBlocking(const ASocket: TFPSocket): specialize TNullable<
+  TFPSocketConnection>;
+var
+  addr: _TAddressUnion;
+  addrLen: TSocklen = SizeOf(addr);
+begin
+  Result.Ptr^.Socket.FD := fpaccept(ASocket.FD, socketsunit.psockaddr(@addr), @addrLen);
+  if SocketInvalid(Result.Ptr^.Socket.FD) then
+    if WouldBlock(socketerror) then
+      Exit(null)
+    else
+      raise ESocketError.Create(socketerror, 'accept');
+  Result.Ptr^.Socket.SocketType := ASocket.SocketType;
+  Result.Ptr^.Socket.Protocol := ASocket.Protocol;
+  ReadAddr(addr, ASocket.SocketType = stIPDualStack, Result.Ptr^.ClientAddress, Result.Ptr^.ClientPort);
+end;
+
+function Connect(const ASocket: TFPSocket; const AAddress: TNetworkAddress;
+  APort: Word): TConnectionState;
+var
+  addr: _TAddressUnion;
+const
+  EALREADY = {$IfDef Windows}WSAEALREADY{$Else}ESysEALREADY{$EndIf};
+  EINPROGRESS = {$IfDef Windows}WSAEINPROGRESS{$Else}ESysEINPROGRESS{$EndIf};
+  ECONNREFUSED = {$IfDef Windows}WSAECONNREFUSED{$Else}ESysECONNREFUSED{$EndIf};
+begin
+  addr := CreateAddr(AAddress, APort, ASocket.SocketType = stIPDualStack);
+  if fpconnect(ASocket.FD, socketsunit.psockaddr(@addr), SizeOf(addr)) <> 0 then
+    case socketerror of
+    EALREADY,
+    EINPROGRESS,
+    EsockEWOULDBLOCK:
+      Exit(csPending);
+    ECONNREFUSED:
+      Exit(csRefused);
+    else
+      raise ESocketError.Create(socketerror, 'connect');
+    end;
+  if ASocket.Protocol<>spStream then
+    Result := csNotConnected
+  else
+    Result := csConnected;
+end;
+
+function Receive(const ASocket: TFPSocket; ABuffer: Pointer; MaxSize: SizeInt;
+  AFlags: Integer): SizeInt;
+begin
+  Result := fprecv(ASocket.FD, ABuffer, MaxSize, AFlags);
+  if Result = 0 then
+    raise EConnectionClosedException.Create('The connection closed')
+  else if Result < 0 then
+    if WouldBlock(socketerror) then
+      Result := 0
+    else
+      raise ESocketError.Create(socketerror, 'recv');
+end;
+
+function ReceiveFrom(const ASocket: TFPSocket; ABuffer: Pointer; MaxSize: SizeInt;
+  AFlags: Integer): TReceiveFromResult;
+var
+  addr: _TAddressUnion;
+  addrLen: TSocklen;
+begin
+  Result := Default(TReceiveFromResult);
+  addrLen := SizeOf(_TAddressUnion);
+  Result.DataSize := fprecvfrom(ASocket.FD, ABuffer, MaxSize, AFlags, socketsunit.PSockAddr(@addr), @addrLen);
+  if Result.DataSize < 0 then
+    if WouldBlock(socketerror) then
+      Exit(Default(TReceiveFromResult)) // Will set the DataSize of return to 0
+    else
+      raise ESocketError.Create(socketerror, 'recvfrom');
+  ReadAddr(addr, ASocket.SocketType = stIPDualStack, Result.FromAddr, Result.FromPort);
+end;
+
+function ReceiveFromNonBlocking(const ASocket:TFPSocket;ABuffer:Pointer;MaxSize:
+  SizeInt;AFlags:Integer):specialize TNullable<TReceiveFromResult>;
+begin
+  Result := ReceiveFromNonBlocking(ASocket, ABuffer, MaxSize, AFlags);
+  if Result.Value.DataSize = 0 then
+    Result := null;
+end;
+
+function Send(const ASocket: TFPSocket; ABuffer: Pointer; ASize: SizeInt;
+  AFlags: Integer): SizeInt;
+begin
+  Result := fpsend(ASocket.FD, ABuffer, ASize, AFlags);
+  if Result < 0 then
+    if WouldBlock(socketerror) then
+      Result := 0
+    else
+      raise ESocketError.Create(socketerror, 'send');
+end;
+
+function SendTo(const ASocket: TFPSocket; const ReceiverAddr: TNetworkAddress;
+  ReceiverPort: Word; ABuffer: Pointer; ASize: SizeInt; AFlags: Integer
+  ): SizeInt;
+var
+  addr: _TAddressUnion;
+begin
+  addr := CreateAddr(ReceiverAddr, ReceiverPort, ASocket.SocketType = stIPDualStack);
+  Result := fpsendto(ASocket.FD, ABuffer, ASize, AFlags, socketsunit.psockaddr(@addr), SizeOf(addr));
+  if Result < 0 then
+    if WouldBlock(socketerror) then
+      Result := 0
+    else
+      raise ESocketError.Create(socketerror, 'sendto');
+end;
+
+function ReceiveStr(const ASocket: TFPSocket; MaxLength: SizeInt;
+  AFlags: Integer): String;
+const
+  ReadSize = 1024;
+var
+  Len, ReadLen: SizeInt;
+begin
+  Result := '';
+  if (MaxLength < 0) and (ASocket.Protocol = spDatagram) then
+    MaxLength := MaxUDPPackageSize;
+  // If maxlength read as much
+  if MaxLength > 0 then
+  begin
+    SetLength(Result, MaxLength);
+    Len := Receive(ASocket, @Result[1], MaxLength, AFlags);
+    SetLength(Result, Len);
+    Exit;
+  end;
+  // If no maxlength do a blocking read (required to figure if stream was closed)
+  Len := 0;
+  MaxLength := BytesAvailable(ASocket);
+  if MaxLength = 0 then
+    MaxLength := ReadSize;
+  repeat
+    SetLength(Result, Len + MaxLength);
+    ReadLen := Receive(ASocket, @Result[1+Len], MaxLength, AFlags);
+    if ReadLen = 0 then // non blocking
+      break;
+    Len += ReadLen;
+    // Check if more was received while reading
+    MaxLength:=BytesAvailable(ASocket);
+  until (Len < Length(Result)) or (MaxLength <= 0);
+  SetLength(Result, Len);
+end;
+
+function ReceiveStrFrom(const ASocket: TFPSocket; MaxLength: SizeInt;
+  AFlags: Integer): TReceiveFromStringMessage;
+var
+  UdpMessage: TReceiveFromResult;
+begin
+  Result := Default(TReceiveFromStringMessage);
+  SetLength(Result.Data, MaxLength);
+  UdpMessage := ReceiveFrom(ASocket, @Result.Data[1], MaxLength, AFlags);
+  SetLength(Result.Data, UdpMessage.DataSize);
+  Result.FromAddr := UdpMessage.FromAddr;
+  Result.FromPort := UdpMessage.FromPort;
+end;
+
+function ReceiveStrFromNonBlocking(const ASocket: TFPSocket;
+  MaxLength: SizeInt; AFlags: Integer): specialize TNullable<
+  TReceiveFromStringMessage>;
+var
+  UdpMessage: TReceiveFromResult;
+begin
+  SetLength(Result.Ptr^.Data, MaxLength);
+  UdpMessage := ReceiveFrom(ASocket, @Result.Ptr^.Data[1], MaxLength, AFlags);
+  if UdpMessage.DataSize = 0 then
+    Exit(null);
+  SetLength(Result.Ptr^.Data, UdpMessage.DataSize);
+  Result.Ptr^.FromAddr := UdpMessage.FromAddr;
+  Result.Ptr^.FromPort := UdpMessage.FromPort;
+end;
+
+function SendStr(const ASocket: TFPSocket; const AData: String; AFlags: Integer
+  ): SizeInt;
+begin
+  if Length(AData) = 0 then Exit(0);
+  Result := Send(ASocket, @AData[1], Length(AData), AFlags);
+end;
+
+function SendStrTo(const ASocket: TFPSocket;
+  const ReceiverAddr: TNetworkAddress; ReceiverPort: Word; const AData: String; AFlags: Integer
+  ): SizeInt;
+begin
+  if Length(AData) = 0 then Exit(0);
+  Result := SendTo(ASocket, ReceiverAddr, ReceiverPort, @AData[1], Length(AData), AFlags);
+end;
+
+generic function Receive<T>(const ASocket: TFPSocket; AFlags: Integer = 0): T;
+var
+  Frag: TBytes;
+  Len, ReadLen: SizeInt;
+begin
+  Result := Default(T);
+  Len := 0;
+  while Len < SizeOf(Result) do
+  begin
+    ReadLen := Receive(ASocket, @PByte(@Result)[Len], SizeOf(Result) - Len, AFlags);
+    if ReadLen = 0 then
+      if Len = 0 then
+        raise ESocketError.Create(EsockEWOULDBLOCK, 'recv')
+      else // Fragment received but non blocking afterwards
+      begin
+        SetLength(Frag, Len);
+        Move(Result, Frag[0], Len);
+        raise EFragmentedData.Create(Frag, SizeOf(T), 'Only fragment received in non blocking read');
+      end;
+    Len += ReadLen;
+  end;
+end;
+
+generic function ReceiveNonBlocking<T>(const ASocket: TFPSocket; AFlags: Integer = 0): specialize TNullable<T>;
+var
+  Frag: TBytes;
+  Len, ReadLen: SizeInt;
+begin
+  Len := 0;
+  while Len < SizeOf(Result.Ptr^) do
+  begin
+    ReadLen := Receive(ASocket, @PByte(@Result.Ptr^)[Len], SizeOf(Result.Ptr^) - Len, AFlags);
+    if ReadLen = 0 then
+      if Len = 0 then
+        Exit(null)
+      else // Fragment received but non blocking afterwards
+      begin
+        SetLength(Frag, Len);
+        Move(Result.Ptr^, Frag[0], Len);
+        raise EFragmentedData.Create(Frag, SizeOf(T), 'Only fragment received in non blocking read');
+      end;
+    Len += ReadLen;
+  end;
+end;
+
+generic function ReceiveFrom<T>(const ASocket: TFPSocket; AFlags: Integer = 0): specialize TReceiveFromMessage<T>;
+var
+  Frag: TBytes;
+  UdpMessage: TReceiveFromResult;
+begin
+  Result := Default(specialize TReceiveFromMessage<T>);
+  UdpMessage := ReceiveFrom(ASocket, @Result.Data, SizeOf(Result.Data), AFlags);
+  if UdpMessage.DataSize < SizeOf(T) then
+    if UdpMessage.DataSize = 0 then
+        raise ESocketError.Create(EsockEWOULDBLOCK, 'recvfrom')
+    else
+    begin
+      SetLength(Frag, UdpMessage.DataSize);
+      Move(Result.Data, Frag[0], UdpMessage.DataSize);
+      raise EFragmentedData.Create(Frag, SizeOf(T), 'Only fragment received ReceiveFrom, likely UDP Fragmentation');
+    end;
+  Result.FromAddr := UdpMessage.FromAddr;
+  Result.FromPort := UdpMessage.FromPort;
+end;
+
+generic function ReceiveFromNonBlocking<T>(const ASocket: TFPSocket; AFlags: Integer = 0): specialize TNullable<specialize TReceiveFromMessage<T>>;
+var
+  Frag: TBytes;
+  UdpMessage: TReceiveFromResult;
+begin
+  UdpMessage := ReceiveFrom(ASocket, @Result.Ptr^.Data, SizeOf(Result.Ptr^.Data), AFlags);
+  if UdpMessage.DataSize < SizeOf(T) then
+    if UdpMessage.DataSize = 0 then
+      Exit(null)
+    else
+    begin
+      SetLength(Frag, UdpMessage.DataSize);
+      Move(Result.Ptr^.Data, Frag[0], UdpMessage.DataSize);
+      raise EFragmentedData.Create(Frag, SizeOf(T), 'Only fragment received ReceiveFrom, likely UDP Fragmentation');
+    end;
+  Result.Ptr^.FromAddr := UdpMessage.FromAddr;
+  Result.Ptr^.FromPort := UdpMessage.FromPort;
+end;
+
+generic function Send<T>(const ASocket: TFPSocket; constref AData: T; AFlags: Integer = 0): SizeInt;
+begin
+  Result := Send(ASocket, @AData, SizeOf(T), AFlags);
+end;
+
+generic function SendTo<T>(const ASocket: TFPSocket; const ReceiverAddr: TNetworkAddress; ReceiverPort: Word; constref AData: T; AFlags: Integer = 0): SizeInt;
+begin
+  Result := SendTo(ASocket, ReceiverAddr, ReceiverPort, @AData, SizeOf(T), AFlags);
+end;
+
+generic function ReceiveArray<T>(const ASocket: TFPSocket; MaxCount: SizeInt;
+  AFlags: Integer = 0): specialize TArray<T>;
+const
+  SizeOfT = SizeOf(T);
+  ReadCount = 1024 div SizeOfT;
+var
+  Frag: TBytes;
+  Len, ReadLen: SizeInt;
+begin
+  Result := nil;
+  if (MaxCount < 0) and (ASocket.Protocol = spDatagram) then
+  {$Push}
+  {$WARN 6018 off}
+    if SizeOf(T) < MaxUDPPackageSize then
+      MaxCount := MaxUDPPackageSize div SizeOf(T)
+    else // Lets try anyway and if it fails it fails
+      MaxCount := 1;
+  {$Pop}
+
+  // If MaxCount, read MaxCount
+  if MaxCount > 0 then
+  begin
+    SetLength(Result, MaxCount);
+    Len := 0;
+    repeat
+      ReadLen := Receive(ASocket, @PByte(@Result[0])[Len], MaxCount * SizeOf(T) - Len, AFlags);
+      if ReadLen = 0 then
+        if Len = 0 then
+          break
+        else
+        begin
+          SetLength(Frag, Len);
+          Move(Result[0], Frag[0], Len);
+          raise EFragmentedData.Create(Frag, (Len div SizeOf(T) + 1) * SizeOf(T),
+            'Receiving of fragmented data is not supported by typed receive');
+        end;
+      Len += ReadLen;
+    until (Len mod SizeOf(T)) = 0;
+    SetLength(Result, Len div SizeOf(T));
+    Exit;
+  end;
+
+  // Else do a (blocking) read and then read as much as in buffer, plus block to finish open blocks
+  Len := 0;
+  MaxCount := BytesAvailable(ASocket) div SizeOfT;
+  {$Push}
+  {$WARN 6018 off}
+  if MaxCount = 0 then
+    if ReadCount = 0 then
+      MaxCount := 1
+    else
+      MaxCount := ReadCount;
+  {$Pop}
+  repeat
+    SetLength(Result, Length(Result)+MaxCount);
+    ReadLen := Receive(ASocket, @PByte(@Result[0])[Len], MaxCount*SizeOfT, AFlags);
+    if ReadLen = 0 then
+      if Len = 0 then
+        break
+      else
+      begin
+        SetLength(Frag, Len);
+        Move(Result[0], Frag[0], Len);
+        raise EFragmentedData.Create(Frag, (Len div SizeOf(T) + 1) * SizeOf(T),
+          'Receiving of fragmented data is not supported by typed receive');
+      end;
+    Len += ReadLen;
+    MaxCount := BytesAvailable(ASocket) div SizeOfT;
+  until ((Len<Length(Result)*SizeOf(T)) Or (MaxCount = 0)) And ((Len mod SizeOf(T)) = 0);
+  SetLength(Result, Len div SizeOf(T));
+end;
+
+generic function ReceiveArrayFrom<T>(const ASocket: TFPSocket; MaxCount: SizeInt;
+  AFlags: Integer = 0): specialize TReceiveFromMessage<specialize TArray<T>>;
+var
+  Frag: TBytes;
+  UdpMessage: TReceiveFromResult;
+begin
+  if MaxCount < 0 then
+    if SizeOf(T) < MaxUDPPackageSize then
+      MaxCount := MaxUDPPackageSize div SizeOf(T)
+    else // Lets try anyway and if it fails it fails
+      MaxCount := 1;
+  Result.Data := nil;
+  SetLength(Result.Data, MaxCount);
+  UdpMessage := ReceiveFrom(ASocket, @Result.Data[0], MaxCount * SizeOf(T), AFlags);
+  if UdpMessage.DataSize mod SizeOf(T) > 0 then
+  begin
+    SetLength(Frag, UdpMessage.DataSize);
+    Move(Result.Data[0], Frag[0], UdpMessage.DataSize);
+    raise EFragmentedData.Create(Frag, (UdpMessage.DataSize div SizeOf(T) + 1) * SizeOf(T),
+      'Receiving of fragmented data is not supported by typed receive');
+  end;
+  SetLength(Result.Data, UdpMessage.DataSize div SizeOf(T));
+  Result.FromAddr := UdpMessage.FromAddr;
+  Result.FromPort := UdpMessage.FromPort;
+end;
+
+generic function ReceiveArrayFromNonBlocking<T>(const ASocket: TFPSocket;
+  MaxCount: SizeInt = -1; AFlags: Integer = 0
+  ): specialize TNullable<specialize TReceiveFromMessage<specialize TArray<T>>>;
+var
+  Frag: TBytes;
+  UdpMessage: TReceiveFromResult;
+begin
+  if MaxCount < 0 then
+    if SizeOf(T) < MaxUDPPackageSize then
+      MaxCount := MaxUDPPackageSize div SizeOf(T)
+    else // Lets try anyway and if it fails it fails
+      MaxCount := 1;
+  Result.Ptr^.Data := nil;
+  SetLength(Result.Ptr^.Data, MaxCount);
+  UdpMessage := ReceiveFrom(ASocket, @Result.Ptr^.Data[0], MaxCount * SizeOf(T), AFlags);
+  if UdpMessage.DataSize = 0 then
+    Exit(null);
+  if UdpMessage.DataSize mod SizeOf(T) > 0 then
+  begin
+    SetLength(Frag, UdpMessage.DataSize);
+    Move(Result.Ptr^.Data[0], Frag[0], UdpMessage.DataSize);
+    raise EFragmentedData.Create(Frag, (UdpMessage.DataSize div SizeOf(T) + 1) * SizeOf(T),
+      'Receiving of fragmented data is not supported by typed receive');
+  end;
+  SetLength(Result.Ptr^.Data, UdpMessage.DataSize div SizeOf(T));
+  Result.Ptr^.FromAddr := UdpMessage.FromAddr;
+  Result.Ptr^.FromPort := UdpMessage.FromPort;
+end;
+
+generic function SendArray<T>(const ASocket: TFPSocket; const AData: specialize TArray<T>; AFlags: Integer = 0): SizeInt;
+begin
+  if Length(AData) = 0 then Exit(0);
+  Result := Send(ASocket, @AData[0], Length(AData) * SizeOf(T), AFlags);
+end;
+
+generic function SendArrayTo<T>(const ASocket: TFPSocket; const ReceiverAddr: TNetworkAddress; ReceiverPort: Word; const AData: specialize TArray<T>; AFlags: Integer = 0): SizeInt;
+begin
+  if Length(AData) = 0 then Exit(0);
+  Result := SendTo(ASocket, ReceiverAddr, ReceiverPort, @AData[0], Length(AData) * SizeOf(T), AFlags);
+end;
+
+procedure SetNonBlocking(const ASocket: TFPSocket; AValue: Boolean);
+{$IfDef Windows}
+var
+  nonblock: u_long;
+begin
+  nonblock := Ord(AValue);
+  ioctlsocket(ASocket.FD, LongInt(FIONBIO), @nonblock);
+end;
+{$Else}
+var
+  State: cint;
+begin
+  State := FpFcntl(ASocket.FD, F_GetFl);
+  if AValue then
+    State := State Or O_NONBLOCK
+  else
+    State := State And not O_NONBLOCK;
+  FpFcntl(ASocket.FD, F_SetFL, state);
+end;
+{$EndIf}
+
+function DataAvailable(const SocketArray: specialize TArray<TFPSocket>;
+  TimeOut: Integer): specialize TArray<TFPSocket>;
+var
+  FDSet: TFDSet;
+  MaxSock: socketsunit.TSocket;
+  timeval: TTimeVal;
+  Ret: LongInt;
+  i, WriteHead: Integer;
+begin
+  Result := nil;
+  MaxSock := 0;
+  {$IfDef UNIX}fpFD_ZERO{$else}FD_ZERO{$endif}(FDSet);
+  for i:=0 to Length(SocketArray) - 1 do
+  begin
+    MaxSock := Max(MaxSock, SocketArray[i].FD);
+    {$IfDef UNIX}fpFD_SET{$else}FD_SET{$endif}(SocketArray[i].FD, FDSet);
+  end;
+  timeval.tv_sec := TimeOut div 1000;
+  timeval.tv_usec := (TimeOut mod 1000) * 1000;
+  Ret := {$IfDef UNIX}fpselect{$else}select{$endif}(MaxSock + 1, @FDSet, nil, nil, @timeval);
+  if Ret < 0 then
+    raise ESocketError.Create(socketerror, 'select');
+
+  SetLength(Result, Ret);
+  WriteHead := 0;
+  for i:=0 to Length(SocketArray) - 1 do
+    if {$IfDef UNIX}fpFD_ISSET{$else}FD_ISSET{$endif}(SocketArray[i].FD, FDSet) {$Ifdef Unix}> 0{$Endif} then
+    begin
+      Result[WriteHead] := SocketArray[i];
+      Inc(WriteHead);
+    end;
+end;
+
+function DataAvailable(const ASocket: TFPSocket; TimeOut: Integer): Boolean;
+var
+  Arr: array of TFPSocket;
+begin
+  Arr := [ASocket];
+  Result := Length(DataAvailable(Arr, TimeOut)) > 0;
+end;
+
+function DataAvailable(const SocketArray: array of TFPSocket; TimeOut: Integer
+  ): specialize TArray<TFPSocket>;
+var
+  Arr: array of TFPSocket;
+begin
+  if Length(SocketArray) = 0 then Exit(nil);
+  SetLength(Arr, Length(SocketArray));
+  Move(SocketArray[0], Arr[0], Length(SocketArray) * SizeOf(SocketArray[0]));
+  Result := DataAvailable(arr, TimeOut);
+end;
+
+function BytesAvailable(const ASocket: TFPSocket): SizeInt;
+var
+  {$IfDef WINDOWS}
+  count: DWord;
+  {$Else}
+  count: cint;
+  {$EndIf}
+begin
+  Result := -1;
+  {$IfDef WINDOWS}
+  if ioctlsocket(ASocket.FD, FIONREAD, @count) = 0 then
+  {$Else}
+  if FpIOCtl(ASocket.FD, FIONREAD, @count) = 0 then
+  {$EndIf}
+    Result := Count;
+end;
+
+function StreamClosed(const ASocket:TFPSocket):Boolean;
+begin
+  Result := (ASocket.Protocol <> spStream) Or (
+              DataAvailable(ASocket, 0) And
+              (BytesAvailable(ASocket) = 0)
+            );
+end;
+
+function ConnectionState(const ASocket:TFPSocket): TConnectionState;
+const
+  ECONNREFUSED = {$IfDef WINDOWS}WSAECONNREFUSED{$ELSE}ESysECONNREFUSED{$EndIf};
+begin
+  if (ASocket.Protocol <> spStream) then
+    Exit(csNotConnected);
+  if (socketsunit.fprecv(ASocket.FD, nil, 0, 0) = 0) And
+     (socketsunit.fpsend(ASocket.FD, nil, 0, 0) = 0) then
+    Exit(csConnected);
+  case socketerror of
+  EsockEWOULDBLOCK: Result := csConnected;
+  ESockENOTCONN: Result := csPending;
+  ECONNREFUSED: Result := csRefused;
+  else
+    Result := csError;
+  end;
+end;
+
+{ ESocketError }
+
+constructor ESocketError.Create(ACode: Integer; const FunName: String);
+begin
+  inherited CreateFmt('[Socket Error: %d] %s call failed',  [ACode, FunName]);
+  FCode := ACode;
+end;
+
+{ EFragmentedData }
+
+constructor EFragmentedData.Create(const AFragment: TBytes; AExpected: SizeInt;
+  const AMessage: String);
+begin
+  inherited Create(AMessage);
+  FFragment := AFragment;
+  FExpectedSize := AExpected;
+end;
+
+end.
+

+ 95 - 0
tests/test/units/fpsockets/tfpsock1.pp

@@ -0,0 +1,95 @@
+program addrtest;
+
+{$mode objfpc}{$H+}
+
+uses
+  fpsockets;
+
+const
+  IN4Val = '127.0.0.1';
+  IN6Val = '132:42::1';
+  IN6ValAlt = '132:42:0::1';
+
+Function TestIN4Addr: String;
+
+var
+  Addr: TNetworkAddress;
+
+begin
+  Result:='';
+  Addr:=IN4Address(IN4Val);
+  if (Addr.AddressType<>atIN4) or (Addr.Address<>IN4Val) then
+    Exit('Error with IN4Address Constructor function');
+end;
+
+Function TestIN6Addr: String;
+
+var
+  Addr: TNetworkAddress;
+
+begin
+  Result:='';
+  Addr:=IN6Address(IN6Val);
+  if (Addr.AddressType<>atIN6) or (Addr.Address<>IN6Val) then
+    Exit('Error with IN6Address Constructor function');
+end;
+
+Function TestAddrDispatch: String;
+
+var
+  Addr: TNetworkAddress;
+
+begin
+  Result:='';
+  Addr:=INAddr(IN4Val);
+  if (Addr.AddressType<>atIN4) or (Addr.Address<>IN4Val) then
+    Exit('Error with INAddr Constructor function');
+  Addr:=INAddr(IN6Val);
+  if (Addr.AddressType<>atIN6) or (Addr.Address<>IN6Val) then
+    Exit('Error with INAddr Constructor function');
+  Addr:=IN4Val;
+  if (Addr.AddressType<>atIN4) or (Addr.Address<>IN4Val) then
+    Exit('Error with Address Assignment Operator');
+  Addr:=IN6Val;
+  if (Addr.AddressType<>atIN6) or (Addr.Address<>IN6Val) then
+    Exit('Error with Address Assignment Operator');
+end;
+
+
+Function TestIN6Equality: String;
+
+var
+  A1, A2: TNetworkAddress;
+
+begin
+  Result:='';
+  if not IN6Equal(IN6Val, IN6ValAlt) then
+    Exit('IN6 Comparison failed');
+  A1:=IN6Address(IN6Val);
+  A2:=IN6Address(IN6ValAlt);
+  if not (A1 = A2) then
+    Exit('IN6 = Comparison failed');
+  if A1 <> A2 then
+    Exit('IN6 <> Comparison failed');
+end;
+
+Procedure DoTest(aTest,aResult : String);
+
+begin
+  if aResult<>'' then
+    begin
+    writeln(aTest,' failed : ',aResult);
+    Halt(1);
+    end
+  else
+    Writeln(aTest,' OK.');
+end;
+
+
+begin
+  DoTest('TestIN4Addr',TestIN4Addr);
+  DoTest('TestIN6Addr',TestIN6Addr);
+  DoTest('TestAddrDispatch',TestAddrDispatch);
+  DoTest('TestIN6Equality',TestIN6Equality);
+end.
+

+ 560 - 0
tests/test/units/fpsockets/tfpsock2.pp

@@ -0,0 +1,560 @@
+program udptest;
+
+{$mode objfpc}{$H+}
+
+uses
+  {$IFDEF UNIX}
+  cthreads,
+  {$ENDIF}
+  Classes, SysUtils, fpsockets, ctypes;
+
+
+const
+{$if defined(win32)}
+  LibName = 'msvcrt';
+{$elseif defined(win64)}
+  LibName = 'msvcrt';
+{$elseif defined(wince)}
+  LibName = 'coredll';
+{$elseif defined(netware)}
+  LibName = 'clib';
+{$elseif defined(netwlibc)}
+  LibName = 'libc';
+{$elseif defined(macos)}
+  LibName = 'StdCLib';
+{$elseif defined(beos)}
+  LibName = 'root';
+{$else}
+  LibName = 'c';
+{$endif}
+
+procedure CExit(status: cint); cdecl; external LibName name 'exit';
+
+const
+  HelloStr = 'Hello Server';
+  ReplyStr = 'Hello Client!';
+
+var ClientError, ServerError: String;
+
+procedure IPv4TestServer;
+var
+  sock: TFPSocket;
+  Received:TReceiveFromStringMessage;
+begin
+  ServerError := '';
+  try
+    sock := UDPSocket(stIPv4);
+    try
+      Bind(sock, '0.0.0.0', 1337);
+      Received := ReceiveStrFrom(sock);
+      sleep(500);
+      SendStrTo(sock, Received.FromAddr, Received.FromPort, ReplyStr);
+    finally
+      CloseSocket(sock);
+    end;
+    if Received.Data <> HelloStr then
+      ServerError := 'Unexpected response: ' + Received.Data;
+  except on E: Exception do
+    ServerError := 'Exception: ' + E.Message;
+  end;
+end;
+
+procedure IPv4TestClient;
+var
+  sock: TFPSocket;
+  Received: TReceiveFromStringMessage;
+begin
+  ClientError := '';
+  try
+    sock := UDPSocket(stIPv4);
+    try
+      Sleep(50);
+      SendStrTo(sock, '127.0.0.1', 1337, HelloStr);
+      Sleep(50);
+      Received := ReceiveStrFrom(sock, 16);
+    finally
+      CloseSocket(sock);
+    end;
+    if Received.Data <> ReplyStr then
+      ClientError := 'Unexpected response: ' + Received.Data;
+  except on E: Exception do
+    ClientError := 'Exception: ' + E.Message;
+  end;
+end;
+
+procedure IPv6TestServer;
+var
+  sock: TFPSocket;
+  Received:TReceiveFromStringMessage;
+begin
+  ServerError := '';
+  try
+    sock := UDPSocket(stIPv6);
+    try
+      Bind(sock, '::0', 1337);
+      Received := ReceiveStrFrom(sock);
+      SendStrTo(sock, Received.FromAddr, Received.FromPort, ReplyStr);
+    finally
+      CloseSocket(sock);
+    end;
+    if Received.Data <> HelloStr then
+      ServerError := 'Unexpected response: ' + Received.Data;
+  except on E: Exception do
+    ServerError := 'Exception: ' + E.Message;
+  end;
+end;
+
+procedure IPv6TestClient;
+var
+  sock: TFPSocket;
+  Received: String;
+begin
+  ClientError := '';
+  try
+    sock := UDPSocket(stIPv6);
+    try
+      Sleep(50);
+      SendStrTo(sock, '::1', 1337, HelloStr);
+      Sleep(50);
+      Received := ReceiveStr(sock);
+      if Received <> ReplyStr then
+        ClientError := 'Unexpected response: ' + Received;
+    finally
+      CloseSocket(sock);
+    end;
+  except on E: Exception do
+    ClientError := 'Exception: ' + E.Message;
+  end;
+end;
+
+procedure DualStackTestServer;
+var
+  sock: TFPSocket;
+  Received:TReceiveFromStringMessage;
+begin
+  ServerError := '';
+  try
+    sock := UDPSocket(stIPDualStack);
+    try
+      Bind(sock, '::0', 1337);
+      Received := ReceiveStrFrom(sock);
+      SendStrTo(sock, Received.FromAddr, Received.FromPort, ReplyStr);
+    finally
+      CloseSocket(sock);
+    end;
+    if not IsIPv4Mapped(Received.FromAddr) then
+      ServerError := 'Expected IPv4 mapped Address, got ' + Received.FromAddr.Address;
+    if Received.Data <> HelloStr then
+      ServerError := 'Unexpected response: ' + Received.Data;
+  except on E: Exception do
+    ServerError := 'Exception: ' + E.Message;
+  end;
+end;
+
+procedure DataAvailableTestClient;
+var
+  sock: TFPSocket;
+begin
+  ClientError := '';
+  try
+    sock := UDPSocket(stIPv4);
+    try
+      Sleep(50);
+      SendStrTo(sock, '127.0.0.1', 1337, HelloStr);
+      Sleep(600);
+      if not DataAvailable(sock) then
+      begin
+        ClientError := 'Should have data from the server pending';
+        Exit;
+      end;
+      if BytesAvailable(sock) <> Length(ReplyStr) then
+        ClientError := 'Unexpected data length';
+    finally
+      CloseSocket(sock);
+    end;
+  except on E: Exception do
+    ClientError := 'Exception: ' + E.Message;
+  end;
+end;
+
+procedure ReceiveArrayTestServer;
+var
+  sock: TFPSocket;
+  Received: specialize TReceiveFromMessage<specialize TArray<Integer>>; // Hello Server = 12 chars = divisible by 4
+  i:Integer;
+begin
+  ServerError := '';
+  try
+    sock := UDPSocket(stIPv4);
+    try
+      Bind(sock, '0.0.0.0', 1337);
+      Received := specialize ReceiveArrayFrom<Integer>(sock);
+      SendStrTo(sock, Received.FromAddr, Received.FromPort, ReplyStr);
+    finally
+      CloseSocket(sock);
+    end;
+    if Length(Received.Data) * SizeOf(Integer) <> Length(HelloStr) then
+    begin
+      ServerError := 'Unexpected response length ' + Length(Received.Data).ToString;
+      Exit;
+    end;
+    for i:=0 to Length(HelloStr) -1 do
+      if PChar(@Received.Data[0])[i]<>HelloStr[i+1] then
+      begin
+        ServerError := 'Unexpected response Char ' + PChar(@Received.Data[0])[i] + '@' + i.ToString;;
+        Exit;
+      end;
+  except on E: Exception do
+    ServerError := 'Exception: ' + E.Message;
+  end;
+end;
+
+procedure ReceiveArrayTestClient;
+var
+  sock: TFPSocket;
+  Received: specialize TReceiveFromMessage<specialize TArray<Char>>;
+  i:Integer;
+begin
+  ClientError := '';
+  try
+    sock := UDPSocket(stIPv4);
+    try
+      Sleep(50);
+      SendStrTo(sock, '127.0.0.1', 1337, HelloStr);
+      Sleep(50);
+      Received := specialize ReceiveArrayFrom<Char>(sock);
+    finally
+      CloseSocket(sock);
+    end;
+    if Length(Received.Data) <> Length(ReplyStr) then
+    begin
+      ClientError := 'Unexpected response length ' + Length(Received.Data).ToString;
+      Exit;
+    end;
+    for i:=0 to Length(Received.Data) -1 do
+      if Received.Data[i]<>ReplyStr[i+1] then
+      begin
+        ClientError := 'Unexpected response Char ' + Received.Data[i] + '@' + i.ToString;
+        Exit;
+      end;
+  except on E: Exception do
+    ClientError := 'Exception: ' + E.Message;
+  end;
+end;
+
+procedure ChunkTestServer;
+type
+  TChunkString = String[16];
+var
+  sock: TFPSocket;
+  Received: specialize TReceiveFromMessage<TChunkString>;
+begin
+  ServerError := '';
+  try
+    sock := UDPSocket(stIPv4);
+    try
+      Bind(sock, '0.0.0.0', 1337);
+      Received := specialize ReceiveFrom<TChunkString>(sock);
+      specialize SendTo<TChunkString>(sock, Received.FromAddr, Received.FromPort, ReplyStr);
+    finally
+      CloseSocket(sock);
+    end;
+    if Received.Data <> HelloStr then
+      ServerError := 'Unexpected response: ' + Received.Data;
+  except on E: Exception do
+    ServerError := 'Exception: ' + E.Message;
+  end;
+end;
+
+procedure ChunkTestClient;
+type
+  TChunkString = String[16];
+var
+  sock: TFPSocket;
+  Received: TChunkString;
+begin
+  ClientError := '';
+  try
+    sock := UDPSocket(stIPv4);
+    try
+      Sleep(50);
+      specialize SendTo<TChunkString>(sock, '127.0.0.1', 1337, HelloStr);
+      Sleep(50);
+      Received := specialize ReceiveFrom<TChunkString>(sock).Data;
+    finally
+      CloseSocket(sock);
+    end; 
+    if Received <> ReplyStr then
+      ClientError := 'Unexpected response: ' + Received;
+  except on E: Exception do
+    ClientError := 'Exception: ' + E.Message;
+  end;
+end;
+
+procedure UDPFragmentationTestServer;
+type
+  TChunkString = String[16];
+var
+  sock: TFPSocket;
+begin
+  ServerError := '';
+  try
+    sock := UDPSocket(stIPv4);
+    try
+      Bind(sock, '0.0.0.0', 1337);
+      try
+        specialize ReceiveFrom<TChunkString>(sock);
+        ServerError := 'Should have thrown fragmentation error';
+      except on E: EFragmentedData do
+        if Length(e.Fragment) <> SizeOf(TChunkString) div 2 then
+          ServerError := 'Unexpected Fragment Size';
+      on E: Exception do
+        raise E;
+      end;
+    finally
+      CloseSocket(sock);
+    end;
+  except on E: Exception do
+    ServerError := 'Exception: ' + E.Message;
+  end;
+end;
+
+procedure UDPFragmentationTestClient;
+type
+  TChunkString = String[16];
+var
+  sock: TFPSocket;
+  toSend: TChunkString;
+begin
+  ClientError := '';
+  try
+    sock := UDPSocket(stIPv4);
+    try
+      Sleep(50);
+      toSend := HelloStr;
+      // Send fragmented in two chunks -> UDP Fragmentation error
+      SendTo(sock, '127.0.0.1', 1337, @toSend, SizeOf(toSend) div 2);
+      Sleep(400);
+      SendTo(sock, '127.0.0.1', 1337, PByte(@toSend) + SizeOf(toSend) div 2, SizeOf(toSend) - SizeOf(toSend) div 2);
+    finally
+      CloseSocket(sock);
+    end;
+  except on E: Exception do
+    ClientError := 'Exception: ' + E.Message;
+  end;
+end;
+
+procedure TestNonBlockingServer;
+var
+  sock: TFPSocket;
+  Received: TReceiveFromStringMessage;
+begin
+  ServerError := '';
+  try
+    sock := UDPSocket(stIPv4);
+    try
+      SetNonBlocking(sock, True);
+      Bind(sock, '0.0.0.0', 1337);
+      while not ReceiveStrFromNonBlocking(sock).Unpack(Received) do
+        Sleep(100);
+      Sleep(500);
+      SendStrTo(sock, Received.FromAddr, Received.FromPort, ReplyStr);
+    finally
+      CloseSocket(sock);
+    end;
+    if Received.Data <> HelloStr then
+      ServerError := 'Unexpected response: ' + Received.Data;
+  except on E: Exception do
+    ServerError := 'Exception: ' + E.Message;
+  end;
+end;
+
+procedure TestNonBlockingClient;
+var
+  sock: TFPSocket;
+  Received: specialize TReceiveFromMessage<specialize TArray<Char>>;
+  i:Integer;
+begin
+  ClientError := '';
+  try
+    sock := UDPSocket(stIPv4);
+    try
+      SetNonBlocking(sock, True);
+      Sleep(200);
+      SendStrTo(sock, '127.0.0.1', 1337, HelloStr);
+      while not specialize ReceiveArrayFromNonBlocking<Char>(sock, 16).unpack(Received) do
+        Sleep(100);
+    finally
+      CloseSocket(sock);
+    end;
+    for i:=0 to Length(Received.Data) -1 do
+      if Received.Data[i]<>ReplyStr[i+1] then
+      begin
+        ClientError := 'Unexpected response Char ' + Received.Data[i] + '@' + i.ToString;;
+        Exit;
+      end;
+  except on E: Exception do
+    ClientError := 'Exception: ' + E.Message;
+  end;
+end;
+
+procedure TestFragmentationServer;
+var
+  sock: TFPSocket;
+begin
+  ServerError := '';
+  try
+    sock := UDPSocket(stIPv4);
+    try
+      Bind(sock, '0.0.0.0', 1337);
+      SetNonBlocking(sock, True);
+      try
+        while not specialize ReceiveFromNonBlocking<LongInt>(sock) do
+          Sleep(50);
+        ServerError := 'Should have thrown fragmentation exception';
+      except on E: EFragmentedData do
+        if Length(e.Fragment) <> SizeOf(Word) then
+          ServerError := 'Unexpected Fragment Size';
+      on E: Exception do
+        raise E;
+      end;
+    finally
+      CloseSocket(sock);
+    end;
+  except on E: Exception do
+    ServerError := 'Exception: ' + E.Message;
+  end;
+end;
+
+procedure TestFragmentationClient;
+var
+  sock: TFPSocket;
+begin
+  ClientError := '';
+  try
+    sock := UDPSocket(stIPv4);
+    try
+      Sleep(50);
+      specialize SendTo<Word>(sock, '127.0.0.1', 1337, 42);
+    finally
+      CloseSocket(sock);
+    end;
+  except on E: Exception do
+    ClientError := 'Exception: ' + E.Message;
+  end;
+end;
+
+procedure TestFragmentedArrayServer;
+var
+  sock: TFPSocket;
+begin
+  ServerError := '';
+  try
+    sock := UDPSocket(stIPv4);
+    try
+      Bind(sock, '0.0.0.0', 1337);
+      SetNonBlocking(sock, True);
+      try
+        while specialize ReceiveArray<LongInt>(sock) = nil do
+          Sleep(50);
+        ServerError := 'Should have thrown fragmentation exception';
+      except on E: EFragmentedData do
+        if Length(e.Fragment) <> SizeOf(LongInt) + SizeOf(Word) then
+          ServerError := 'Unexpected Fragment Size';
+      on E: Exception do
+        raise E;
+      end;
+    finally
+      CloseSocket(sock);
+    end;
+  except on E: Exception do
+    ServerError := 'Exception: ' + E.Message;
+  end;
+end;
+
+procedure TestFragmentedArrayClient;
+var
+  sock: TFPSocket;
+begin
+  ClientError := '';
+  try
+    sock := UDPSocket(stIPv4);
+    try
+      Sleep(100);
+      specialize SendArrayTo<Word>(sock, '127.0.0.1', 1337, [42, 43, 44]);
+    finally
+      CloseSocket(sock);
+    end;
+  except on E: Exception do
+    ClientError := 'Exception: ' + E.Message;
+  end;
+end;
+
+type
+  TTimeoutThread = class(TThread)
+  protected
+    procedure Execute;override;
+  end;
+
+procedure TTimeoutThread.Execute;
+var
+  i: Integer;
+begin
+  for i:=1 to 100 do
+  begin
+    if Terminated then
+      Exit;
+    Sleep(100);
+  end;
+  if Terminated then
+    Exit;
+  WriteLn(' Timeout');
+  // FPC Halt does not work with threads... so we just rawkill using libc
+  cexit(1);
+end;
+
+procedure RunTest(const TestName: String; ASrv, ACli: TProcedure);
+var
+  Timeout, SrvThread, CliThread: TThread;
+begin
+  Write('Testing ', TestName, '...');
+  SrvThread:=TThread.CreateAnonymousThread(ASrv);
+  SrvThread.FreeOnTerminate := False;
+  SrvThread.Start;
+  CliThread:=TThread.CreateAnonymousThread(ACli);
+  CliThread.FreeOnTerminate := False;
+  CliThread.Start;
+  Timeout:=TTimeoutThread.Create(false);
+  SrvThread.WaitFor;
+  if not ServerError.IsEmpty then
+  begin
+    WriteLn(LineEnding, '  Server Error: ', ServerError);
+    Halt(1);
+  end;
+  CliThread.WaitFor;
+  if not ClientError.IsEmpty then
+  begin
+    WriteLn(LineEnding, '  Client Error: ', ClientError);
+    Halt(1);
+  end;
+  Timeout.Terminate;
+  Timeout.Free;
+  WriteLn(' Success!');
+  CliThread.Free;
+  SrvThread.Free;
+  Sleep(500);
+end;
+
+begin
+  RunTest('IPv4Test', @IPv4TestServer, @IPv4TestClient);
+  RunTest('IPv6Test', @IPv6TestServer, @IPv6TestClient);
+  RunTest('DualStackTest', @DualStackTestServer, @IPv4TestClient);
+  RunTest('DataAvailableTest', @IPv4TestServer, @DataAvailableTestClient);
+  RunTest('ReceiveArrayTest', @ReceiveArrayTestServer, @ReceiveArrayTestClient);
+  RunTest('ChunkTest', @ChunkTestServer, @ChunkTestClient);
+  RunTest('UDPFragmentationTest', @UDPFragmentationTestServer, @UDPFragmentationTestClient);
+  RunTest('NonBlockingTest', @TestNonBlockingServer, @TestNonBlockingClient);
+  RunTest('FragmentationTest', @TestFragmentationServer, @TestFragmentationClient);
+  RunTest('FragmentedArrayTest', @TestFragmentedArrayServer, @TestFragmentedArrayClient);
+end.
+

+ 741 - 0
tests/test/units/fpsockets/tfpsock3.pp

@@ -0,0 +1,741 @@
+program tcptest;
+
+{$mode objfpc}{$H+}
+
+uses
+  {$IFDEF UNIX}
+  cthreads,
+  {$ENDIF}
+  Classes, SysUtils, fpsockets, ctypes;
+
+
+const
+{$if defined(win32)}
+  LibName = 'msvcrt';
+{$elseif defined(win64)}
+  LibName = 'msvcrt';
+{$elseif defined(wince)}
+  LibName = 'coredll';
+{$elseif defined(netware)}
+  LibName = 'clib';
+{$elseif defined(netwlibc)}
+  LibName = 'libc';
+{$elseif defined(macos)}
+  LibName = 'StdCLib';
+{$elseif defined(beos)}
+  LibName = 'root';
+{$else}
+  LibName = 'c';
+{$endif}
+
+procedure CExit(status: cint); cdecl; external LibName name 'exit';
+
+const
+  HelloStr = 'Hello Server';
+  ReplyStr = 'Hello Client!';
+
+var ClientError, ServerError: String;
+
+procedure IPv4TestServer;
+var
+  sock: TFPSocket;
+  Conn: TFPSocketConnection;
+  Received: String;
+begin
+  ServerError := '';
+  try
+    sock := TCPSocket(stIPv4);
+    try
+      Bind(sock, '0.0.0.0', 1337);
+      Listen(sock, 0);
+      Conn := AcceptConnection(sock);
+      try
+        Received := ReceiveStr(Conn.Socket);
+        sleep(500);
+        SendStr(Conn.Socket, ReplyStr);
+      finally
+        CloseSocket(Conn.Socket);
+      end;
+    finally
+      CloseSocket(sock);
+    end;
+    if Received <> HelloStr then
+      ServerError := 'Unexpected response: ' + Received;
+  except on E: Exception do
+    ServerError := 'Exception: ' + E.Message;
+  end;
+end;
+
+procedure IPv4TestClient;
+var
+  sock: TFPSocket;
+  Received: String;
+begin
+  ClientError := '';
+  try
+    sock := TCPSocket(stIPv4);
+    try
+      Connect(sock, '127.0.0.1', 1337);
+      SendStr(sock, HelloStr);
+      Received := ReceiveStr(sock, 16);
+      if Received <> ReplyStr then
+        ClientError := 'Unexpected response: ' + Received;
+    finally
+      CloseSocket(sock);
+    end;
+  except on E: Exception do
+    ClientError := 'Exception: ' + E.Message;
+  end;
+end;
+
+procedure IPv6TestServer;
+var
+  sock: TFPSocket;
+  Conn: TFPSocketConnection;
+  Received: String;
+begin
+  ServerError := '';
+  try
+    sock := TCPSocket(stIPv6);
+    try
+      Bind(sock, '::0', 1337);
+      Listen(sock, 0);
+      Conn := AcceptConnection(sock);
+      try
+        Received := ReceiveStr(Conn.Socket);
+        SendStr(Conn.Socket, ReplyStr);
+      finally
+        CloseSocket(Conn.Socket);
+      end;
+    finally
+      CloseSocket(sock);
+    end;
+    if Received <> HelloStr then
+      ServerError := 'Unexpected response: ' + Received;
+  except on E: Exception do
+    ServerError := 'Exception: ' + E.Message;
+  end;
+end;
+
+procedure IPv6TestClient;
+var
+  sock: TFPSocket;
+  Received: String;
+begin
+  ClientError := '';
+  try
+    sock := TCPSocket(stIPv6);
+    try
+      Connect(sock, '::1', 1337);
+      SendStr(sock, HelloStr);
+      Received := ReceiveStr(sock);
+      if Received <> ReplyStr then
+        ClientError := 'Unexpected response: ' + Received;
+    finally
+      CloseSocket(sock);
+    end;
+  except on E: Exception do
+    ClientError := 'Exception: ' + E.Message;
+  end;
+end;
+
+procedure DualStackTestServer;
+var
+  sock: TFPSocket;
+  Conn: TFPSocketConnection;
+  Received: String;
+begin
+  ServerError := '';
+  try
+    sock := TCPSocket(stIPDualStack);
+    try
+      Bind(sock, '::0', 1337);
+      Listen(sock, 0);
+      Conn := AcceptConnection(sock);
+      try
+        Received := ReceiveStr(Conn.Socket);
+        SendStr(Conn.Socket, ReplyStr);
+      finally
+        CloseSocket(Conn.Socket);
+      end;
+    finally
+      CloseSocket(sock);
+    end;
+    if not IsIPv4Mapped(Conn.ClientAddress) then
+      ServerError := 'Expected IPv4 mapped Address, got ' + Conn.ClientAddress.Address;
+    if Received <> HelloStr then
+      ServerError := 'Unexpected response: ' + Received;
+  except on E: Exception do
+    ServerError := 'Exception: ' + E.Message;
+  end;
+end;
+
+procedure CloseTestServer;
+var
+  sock: TFPSocket;
+  Conn: TFPSocketConnection;
+begin
+  ServerError := '';
+  try
+    sock := TCPSocket(stIPv4);
+    try
+      Bind(sock, '0.0.0.0', 1337);
+      Listen(sock, 0);
+      Conn := AcceptConnection(sock);
+      CloseSocket(Conn.Socket);
+    finally
+      CloseSocket(sock);
+    end;
+  except on E: Exception do
+    ServerError := 'Exception: ' + E.Message;
+  end;
+end;
+
+procedure CloseTestClient;
+var
+  sock: TFPSocket;
+begin
+  ClientError := '';
+  try
+    sock := TCPSocket(stIPv4);
+    try
+      Connect(sock, '127.0.0.1', 1337);
+      Sleep(100);
+      if not StreamClosed(sock) then
+      begin
+        ClientError := 'Should detect closed stream by server';
+        Exit;
+      end;
+      try
+        ReceiveStr(sock);
+        ClientError := 'Should detect closed stream by server';
+      except on E: EConnectionClosedException do
+      end;
+    finally
+      CloseSocket(sock);
+    end;
+  except on E: Exception do
+    ClientError := 'Exception: ' + E.Message;
+  end;
+end;
+
+procedure DataAvailableTestClient;
+var
+  sock: TFPSocket;
+begin
+  ClientError := '';
+  try
+    sock := TCPSocket(stIPv4);
+    try
+      Connect(sock, '127.0.0.1', 1337);
+      SendStr(sock, HelloStr);
+      Sleep(600);
+      if not DataAvailable(sock) then
+      begin
+        ClientError := 'Should have data from the server pending';
+        Exit;
+      end;
+      if BytesAvailable(sock) <> Length(ReplyStr) then
+        ClientError := 'Unexpected data length';
+    finally
+      CloseSocket(sock);
+    end;
+  except on E: Exception do
+    ClientError := 'Exception: ' + E.Message;
+  end;
+end;
+
+procedure ReceiveArrayTestServer;
+var
+  sock: TFPSocket;
+  Conn: TFPSocketConnection;
+  Received: Array of Integer; // Hello Server = 12 chars = divisible by 4
+  i:Integer;
+begin
+  ServerError := '';
+  try
+    sock := TCPSocket(stIPv4);
+    try
+      Bind(sock, '0.0.0.0', 1337);
+      Listen(sock, 0);
+      Conn := AcceptConnection(sock);
+      try
+        Received := specialize ReceiveArray<Integer>(Conn.Socket);
+        SendStr(Conn.Socket, ReplyStr);
+      finally
+        CloseSocket(Conn.Socket);
+      end;
+    finally
+      CloseSocket(sock);
+    end;
+    if Length(Received) * SizeOf(Integer) <> Length(HelloStr) then
+    begin
+      ServerError := 'Unexpected response length ' + Length(Received).ToString;
+      Exit;
+    end;
+    for i:=0 to Length(HelloStr) -1 do
+      if PChar(@Received[0])[i]<>HelloStr[i+1] then
+      begin
+        ServerError := 'Unexpected response Char ' + PChar(@Received[0])[i] + '@' + i.ToString;;
+        Exit;
+      end;
+  except on E: Exception do
+    ServerError := 'Exception: ' + E.Message;
+  end;
+end;
+
+procedure ReceiveArrayTestClient;
+var
+  sock: TFPSocket;
+  Received: Array of Char;
+  i:Integer;
+begin
+  ClientError := '';
+  try
+    sock := TCPSocket(stIPv4);
+    try
+      Connect(sock, '127.0.0.1', 1337);
+      SendStr(sock, HelloStr);
+      Received := specialize ReceiveArray<Char>(sock);
+    finally
+      CloseSocket(sock);
+    end;
+    if Length(Received) <> Length(ReplyStr) then
+    begin
+      ClientError := 'Unexpected response length ' + Length(Received).ToString;
+      Exit;
+    end;
+    for i:=0 to Length(Received) -1 do
+      if Received[i]<>ReplyStr[i+1] then
+      begin
+        ClientError := 'Unexpected response Char ' + Received[i] + '@' + i.ToString;
+        Exit;
+      end;
+  except on E: Exception do
+    ClientError := 'Exception: ' + E.Message;
+  end;
+end;
+
+procedure ChunkTestServer;
+type
+  TChunkString = String[16];
+var
+  sock: TFPSocket;
+  Conn: TFPSocketConnection;
+  Received, toSend: TChunkString;
+begin
+  ServerError := '';
+  try
+    sock := TCPSocket(stIPv4);
+    try
+      Bind(sock, '0.0.0.0', 1337);
+      Listen(sock, 0);
+      Conn := AcceptConnection(sock);
+      try
+        Received := specialize Receive<TChunkString>(Conn.Socket);
+        ToSend := ReplyStr;
+        // Send in two halves with time delay (client must block until full chunk)
+        Send(Conn.Socket, @toSend, SizeOf(toSend) div 2);
+        Sleep(400);
+        Send(Conn.Socket, PByte(@toSend) + SizeOf(toSend) div 2, SizeOf(toSend) - SizeOf(toSend) div 2);
+      finally
+        CloseSocket(Conn.Socket);
+      end;
+    finally
+      CloseSocket(sock);
+    end;
+    if Received <> HelloStr then
+      ServerError := 'Unexpected response: ' + Received;
+  except on E: Exception do
+    ServerError := 'Exception: ' + E.Message;
+  end;
+end;
+
+procedure ChunkTestClient;
+type
+  TChunkString = String[16];
+var
+  sock: TFPSocket;
+  Received: TChunkString;
+begin
+  ClientError := '';
+  try
+    sock := TCPSocket(stIPv4);
+    try
+      Connect(sock, '127.0.0.1', 1337);
+      specialize Send<TChunkString>(sock, HelloStr);
+      Received := specialize Receive<TChunkString>(sock);
+      if Received <> ReplyStr then
+        ClientError := 'Unexpected response: ' + Received;
+    finally
+      CloseSocket(sock);
+    end;
+  except on E: Exception do
+    ClientError := 'Exception: ' + E.Message;
+  end;
+end;
+
+procedure TestNonBlockingServer;
+var
+  sock: TFPSocket;
+  Conn: TFPSocketConnection;
+  Received: String;
+begin
+  ServerError := '';
+  try
+    sock := TCPSocket(stIPv4);
+    try
+      SetNonBlocking(sock, True);
+      Bind(sock, '0.0.0.0', 1337);
+      Listen(sock, 0);
+      while not AcceptNonBlocking(sock).Unpack(Conn) do
+        Sleep(100);
+      try
+        SetNonBlocking(Conn.Socket, True);
+        repeat
+          Received := ReceiveStr(Conn.Socket);
+          Sleep(100);
+        until Received<>'';
+        Sleep(500);
+        SendStr(Conn.Socket, ReplyStr);
+      finally
+        CloseSocket(Conn.Socket);
+      end;
+    finally
+      CloseSocket(sock);
+    end;
+    if Received <> HelloStr then
+      ServerError := 'Unexpected response: ' + Received;
+  except on E: Exception do
+    ServerError := 'Exception: ' + E.Message;
+  end;
+end;
+
+procedure TestNonBlockingClient;
+var
+  sock: TFPSocket;
+  Received: Array of Char;
+  State:TConnectionState;
+  i:Integer;
+begin
+  ClientError := '';
+  try
+    sock := TCPSocket(stIPv4);
+    try
+      SetNonBlocking(sock, True);
+      Sleep(200);
+      State := Connect(sock, '127.0.0.1', 1337);
+      while State = csPending do
+      begin
+        Sleep(100);
+        State:=ConnectionState(sock);
+      end;
+      if State <> csConnected then
+      begin
+        ClientError := 'Connection not successful';
+        Exit;
+      end;
+      Sleep(200);
+      SendStr(sock, HelloStr);
+      repeat
+        Received := specialize ReceiveArray<Char>(sock, 16);
+        Sleep(100);
+      until Received<>nil;
+    finally
+      CloseSocket(sock);
+    end;
+    for i:=0 to Length(Received) -1 do
+      if Received[i]<>ReplyStr[i+1] then
+      begin
+        ClientError := 'Unexpected response Char ' + Received[i] + '@' + i.ToString;;
+        Exit;
+      end;
+  except on E: Exception do
+    ClientError := 'Exception: ' + E.Message;
+  end;
+end;
+
+{$IfDef Unix}
+// Different behavior between winsock and berkley sockets
+// Seems like winsock does not provide refused when the server closes while pending
+procedure TestRefusedServer;
+var
+  sock: TFPSocket;
+begin
+  ServerError := '';
+  try
+    sock := TCPSocket(stIPv4);
+    try
+      Bind(sock, '0.0.0.0', 1337);
+      Listen(sock, 1);
+    finally
+      CloseSocket(sock);
+    end;
+  except on E: Exception do
+    ServerError := 'Exception: ' + E.Message;
+  end;
+end;
+
+procedure TestRefusedClient;
+var
+  sock: TFPSocket;
+  State: TConnectionState;
+begin
+  ClientError := '';
+  try
+    sock := TCPSocket(stIPv4);
+    try
+      SetNonBlocking(sock, True);
+      Connect(sock, '127.0.0.1', 1337);
+      Sleep(200);
+      State:=ConnectionState(sock);
+      if State <> csRefused then
+      begin
+        ClientError := 'Connection should be refused';
+        Exit;
+      end;
+    finally
+      CloseSocket(sock);
+    end;
+  except on E: Exception do
+    ClientError := 'Exception: ' + E.Message;
+  end;
+end;
+{$EndIf}
+
+procedure TestFragmentationServer;
+var
+  sock: TFPSocket;
+  Conn: TFPSocketConnection;
+begin
+  ServerError := '';
+  try
+    sock := TCPSocket(stIPv4);
+    try
+      Bind(sock, '0.0.0.0', 1337);
+      Listen(sock, 0);
+      Conn := AcceptConnection(sock);
+      try
+        SetNonBlocking(Conn.Socket, True);
+        try
+          while not specialize ReceiveNonBlocking<LongInt>(Conn.Socket) do
+            Sleep(50);
+          ServerError := 'Should have thrown fragmentation exception';
+        except on E: EFragmentedData do
+          if Length(e.Fragment) <> SizeOf(Word) then
+            ServerError := 'Unexpected Fragment Size';
+        on E: Exception do
+          raise E;
+        end;
+      finally
+        CloseSocket(Conn.Socket);
+      end;
+    finally
+      CloseSocket(sock);
+    end;
+  except on E: Exception do
+    ServerError := 'Exception: ' + E.Message;
+  end;
+end;
+
+procedure TestFragmentationClient;
+var
+  sock: TFPSocket;
+begin
+  ClientError := '';
+  try
+    sock := TCPSocket(stIPv4);
+    try
+      Connect(sock, '127.0.0.1', 1337);
+      specialize Send<Word>(sock, 42);
+      Sleep(100);
+    finally
+      CloseSocket(sock);
+    end;
+  except on E: Exception do
+    ClientError := 'Exception: ' + E.Message;
+  end;
+end;
+
+procedure TestFragmentedArrayServer;
+var
+  sock: TFPSocket;
+  Conn: TFPSocketConnection;
+begin
+  ServerError := '';
+  try
+    sock := TCPSocket(stIPv4);
+    try
+      Bind(sock, '0.0.0.0', 1337);
+      Listen(sock, 0);
+      Conn := AcceptConnection(sock);
+      try
+        SetNonBlocking(Conn.Socket, True);
+        try
+          while specialize ReceiveArray<LongInt>(Conn.Socket) = nil do
+            Sleep(50);
+          ServerError := 'Should have thrown fragmentation exception';
+        except on E: EFragmentedData do
+          if Length(e.Fragment) <> SizeOf(Word) then
+            ServerError := 'Unexpected Fragment Size';
+        on E: Exception do
+          raise E;
+        end;
+      finally
+        CloseSocket(Conn.Socket);
+      end;
+    finally
+      CloseSocket(sock);
+    end;
+  except on E: Exception do
+    ServerError := 'Exception: ' + E.Message;
+  end;
+end;
+
+procedure TestFragmentedArrayClient;
+var
+  sock: TFPSocket;
+begin
+  ClientError := '';
+  try
+    sock := TCPSocket(stIPv4);
+    try
+      Connect(sock, '127.0.0.1', 1337);
+      specialize SendArray<Word>(sock, [42]);
+      Sleep(100);
+    finally
+      CloseSocket(sock);
+    end;
+  except on E: Exception do
+    ClientError := 'Exception: ' + E.Message;
+  end;
+end;
+
+{ When trying to read an array, and the array is fragmented, and you give it a
+  read size thats larger than whats in the buffer, instead of a fragmented
+  exception, a connection closed exception will be raised.
+  This is suboptimal/undesired behavior, but arises from the internal calls to
+  Receive, which raises an exception on end of stream. This test verifies that,
+  arguably faulty behavior, so it may very well be fixed in the future }
+procedure TestFragmentedCloseServer;
+var
+  sock: TFPSocket;
+  Conn: TFPSocketConnection;
+begin
+  ServerError := '';
+  try
+    sock := TCPSocket(stIPv4);
+    try
+      Bind(sock, '0.0.0.0', 1337);
+      Listen(sock, 0);
+      Conn := AcceptConnection(sock);
+      try
+        try
+          Sleep(100);
+          specialize ReceiveArray<LongInt>(Conn.Socket, 2);
+          ServerError := 'Should have thrown ConnectionClosed Exception';
+        except on E: EConnectionClosedException do ;
+        on E: Exception do
+          raise E;
+        end;
+      finally
+        CloseSocket(Conn.Socket);
+      end;
+    finally
+      CloseSocket(sock);
+    end;
+  except on E: Exception do
+    ServerError := 'Exception: ' + E.Message;
+  end;
+end;
+
+procedure TestFragmentedCloseClient;
+var
+  sock: TFPSocket;
+begin
+  ClientError := '';
+  try
+    sock := TCPSocket(stIPv4);
+    try
+      Connect(sock, '127.0.0.1', 1337);
+      specialize SendArray<Word>(sock, [42, 43, 44]);
+      Sleep(100);
+    finally
+      CloseSocket(sock);
+    end;
+  except on E: Exception do
+    ClientError := 'Exception: ' + E.Message;
+  end;
+end;
+
+type
+  TTimeoutThread = class(TThread)
+  protected
+    procedure Execute;override;
+  end;
+
+procedure TTimeoutThread.Execute;
+var
+  i: Integer;
+begin
+  for i:=1 to 100 do
+  begin
+    if Terminated then
+      Exit;
+    Sleep(100);
+  end; 
+  if Terminated then
+    Exit;
+  WriteLn(' Timeout');
+  // FPC Halt does not work with threads... so we just rawkill using libc
+  cexit(1);
+end;
+
+procedure RunTest(const TestName: String; ASrv, ACli: TProcedure);
+var
+  Timeout, SrvThread, CliThread: TThread;
+begin
+  Write('Testing ', TestName, '...');
+  SrvThread:=TThread.CreateAnonymousThread(ASrv);
+  SrvThread.FreeOnTerminate := False;
+  SrvThread.Start;
+  CliThread:=TThread.CreateAnonymousThread(ACli);
+  CliThread.FreeOnTerminate := False;
+  CliThread.Start;
+  Timeout:=TTimeoutThread.Create(false);
+  SrvThread.WaitFor;
+  if not ServerError.IsEmpty then
+  begin
+    WriteLn(LineEnding, '  Server Error: ', ServerError);
+    Halt(1);
+  end;
+  CliThread.WaitFor;
+  if not ClientError.IsEmpty then
+  begin
+    WriteLn(LineEnding, '  Client Error: ', ClientError);
+    Halt(1);
+  end;
+  Timeout.Terminate;
+  Timeout.Free;
+  WriteLn(' Success!');
+  CliThread.Free;
+  SrvThread.Free;
+  Sleep(800);
+end;
+
+begin
+  RunTest('IPv4Test', @IPv4TestServer, @IPv4TestClient);
+  RunTest('IPv6Test', @IPv6TestServer, @IPv6TestClient);
+  RunTest('DualStackTest', @DualStackTestServer, @IPv4TestClient);
+  RunTest('CloseTest', @CloseTestServer, @CloseTestClient);
+  RunTest('DataAvailableTest', @IPv4TestServer, @DataAvailableTestClient);
+  RunTest('ReceiveArrayTest', @ReceiveArrayTestServer, @ReceiveArrayTestClient);
+  RunTest('ChunkTest', @ChunkTestServer, @ChunkTestClient);
+  RunTest('NonBlockingTest', @TestNonBlockingServer, @TestNonBlockingClient);
+  {$IfDef Unix}
+  RunTest('RefusedTest', @TestRefusedServer, @TestRefusedClient);
+  {$EndIf}
+  RunTest('FragmentationTest', @TestFragmentationServer, @TestFragmentationClient);
+  RunTest('FragmentedArrayTest', @TestFragmentedArrayServer, @TestFragmentedArrayClient);
+  RunTest('FragmentedCloseTest', @TestFragmentedCloseServer, @TestFragmentedCloseClient);
+end.