1297 lines
36 KiB
ObjectPascal
1297 lines
36 KiB
ObjectPascal
/// low level access to network Sockets for FPC (and Kylix) POSIX cross-platform
|
|
// - this unit is a part of the freeware Synopse framework,
|
|
// licensed under a MPL/GPL/LGPL tri-license; version 1.18
|
|
unit SynFPCSock;
|
|
|
|
{
|
|
This file is part of Synopse framework.
|
|
|
|
Synopse framework. Copyright (C) 2022 Arnaud Bouchez
|
|
Synopse Informatique - https://synopse.info
|
|
|
|
*** BEGIN LICENSE BLOCK *****
|
|
Version: MPL 1.1/GPL 2.0/LGPL 2.1
|
|
|
|
The contents of this file are subject to the Mozilla Public License Version
|
|
1.1 (the "License"); you may not use this file except in compliance with
|
|
the License. You may obtain a copy of the License at
|
|
http://www.mozilla.org/MPL
|
|
|
|
Software distributed under the License is distributed on an "AS IS" basis,
|
|
WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License
|
|
for the specific language governing rights and limitations under the License.
|
|
|
|
The Original Code is Synapse library.
|
|
|
|
The Initial Developer of the Original Code is Lukas Gebauer (Czech Republic).
|
|
Portions created by Lukas Gebauer are Copyright (C) 2003.
|
|
All Rights Reserved.
|
|
|
|
Portions created by Arnaud Bouchez are Copyright (C) 2022 Arnaud Bouchez.
|
|
All Rights Reserved.
|
|
|
|
Contributor(s):
|
|
- Alfred Glaenzer
|
|
|
|
Alternatively, the contents of this file may be used under the terms of
|
|
either the GNU General Public License Version 2 or later (the "GPL"), or
|
|
the GNU Lesser General Public License Version 2.1 or later (the "LGPL"),
|
|
in which case the provisions of the GPL or the LGPL are applicable instead
|
|
of those above. If you wish to allow use of your version of this file only
|
|
under the terms of either the GPL or the LGPL, and not to allow others to
|
|
use your version of this file under the terms of the MPL, indicate your
|
|
decision by deleting the provisions above and replace them with the notice
|
|
and other provisions required by the GPL or the LGPL. If you do not delete
|
|
the provisions above, a recipient may use your version of this file under
|
|
the terms of any one of the MPL, the GPL or the LGPL.
|
|
|
|
***** END LICENSE BLOCK *****
|
|
|
|
Low level access to network Sockets
|
|
*************************************
|
|
|
|
Shared by Kylix and FPC for all POSIX systems.
|
|
|
|
}
|
|
|
|
{$ifdef FPC}
|
|
|
|
{$MODE DELPHI}
|
|
{$H+}
|
|
|
|
{.$define USELIBC}
|
|
|
|
{$ifdef ANDROID}
|
|
{$define LINUX} // a Linux-based system
|
|
{$endif}
|
|
|
|
// BSD definition of socketaddr
|
|
{$if
|
|
defined(OpenBSD) or
|
|
defined(FreeBSD) or
|
|
defined(Darwin) or
|
|
defined(Haiku)
|
|
}
|
|
{$DEFINE SOCK_HAS_SINLEN} // BSD definition of socketaddr
|
|
{$endif}
|
|
{$ifdef SUNOS}
|
|
{$DEFINE SOCK_HAS_SINLEN}
|
|
{$endif}
|
|
|
|
{$else}
|
|
|
|
{$ifdef LINUX}
|
|
{$define KYLIX3}
|
|
{$else}
|
|
this unit is for FPC or (Cross-)Kylix only!
|
|
{$endif}
|
|
|
|
{$endif FPC}
|
|
|
|
interface
|
|
|
|
uses
|
|
SysUtils,
|
|
{$ifdef FPC}
|
|
BaseUnix,
|
|
Unix,
|
|
{$ifdef Linux}
|
|
Linux, // for epoll support
|
|
{$endif Linux}
|
|
termio,
|
|
netdb,
|
|
Sockets, // most definitions are inlined in SynFPCSock to avoid Lazarus problems with Sockets.pp
|
|
SynFPCLinux,
|
|
{$else}
|
|
{$ifdef KYLIX3}
|
|
LibC,
|
|
Types,
|
|
KernelIoctl,
|
|
SynKylix,
|
|
{$endif}
|
|
{$endif FPC}
|
|
SyncObjs,
|
|
Classes;
|
|
|
|
const
|
|
InitSocketInterface = true;
|
|
|
|
procedure DestroySocketInterface;
|
|
|
|
{$MINENUMSIZE 4}
|
|
|
|
const
|
|
DLLStackName = '';
|
|
WinsockLevel = $0202;
|
|
|
|
cLocalHost = '127.0.0.1';
|
|
cAnyHost = '0.0.0.0';
|
|
c6AnyHost = '::0';
|
|
c6Localhost = '::1';
|
|
cLocalHostStr = 'localhost';
|
|
|
|
{$ifdef FPC}
|
|
type
|
|
TSocket = longint;
|
|
|
|
TFDSet = Baseunix.TFDSet;
|
|
PFDSet = ^TFDSet;
|
|
Ptimeval = Baseunix.ptimeval;
|
|
Ttimeval = Baseunix.ttimeval;
|
|
|
|
PInAddr = ^TInAddr;
|
|
TInAddr = sockets.in_addr;
|
|
|
|
PSockAddrIn = ^TSockAddrIn;
|
|
TSockAddrIn = sockets.TInetSockAddr;
|
|
|
|
PInAddr6 = ^TInAddr6;
|
|
TInAddr6 = sockets.Tin6_addr;
|
|
|
|
PSockAddrIn6 = ^TSockAddrIn6;
|
|
TSockAddrIn6 = sockets.TInetSockAddr6;
|
|
|
|
TSockAddr = sockets.TSockAddr;
|
|
PSockAddr = sockets.PSockAddr;
|
|
|
|
const
|
|
FIONREAD = termio.FIONREAD;
|
|
FIONBIO = termio.FIONBIO;
|
|
FIOASYNC = termio.FIOASYNC;
|
|
|
|
IP_TOS = sockets.IP_TOS; { int; IP type of service and precedence. }
|
|
IP_TTL = sockets.IP_TTL; { int; IP time to live. }
|
|
IP_HDRINCL = sockets.IP_HDRINCL; { int; Header is included with data. }
|
|
IP_OPTIONS = sockets.IP_OPTIONS; { ip_opts; IP per-packet options. }
|
|
IP_RECVOPTS = sockets.IP_RECVOPTS; { bool }
|
|
IP_RETOPTS = sockets.IP_RETOPTS; { bool }
|
|
IP_MULTICAST_IF = sockets.IP_MULTICAST_IF; { in_addr; set/get IP multicast i/f }
|
|
IP_MULTICAST_TTL = sockets.IP_MULTICAST_TTL; { u_char; set/get IP multicast ttl }
|
|
IP_MULTICAST_LOOP = sockets.IP_MULTICAST_LOOP; { i_char; set/get IP multicast loopback }
|
|
IP_ADD_MEMBERSHIP = sockets.IP_ADD_MEMBERSHIP; { ip_mreq; add an IP group membership }
|
|
IP_DROP_MEMBERSHIP = sockets.IP_DROP_MEMBERSHIP; { ip_mreq; drop an IP group membership }
|
|
|
|
SHUT_RD = sockets.SHUT_RD;
|
|
SHUT_WR = sockets.SHUT_WR;
|
|
SHUT_RDWR = sockets.SHUT_RDWR;
|
|
|
|
SOL_SOCKET = sockets.SOL_SOCKET;
|
|
|
|
SO_DEBUG = sockets.SO_DEBUG;
|
|
SO_REUSEADDR = sockets.SO_REUSEADDR;
|
|
{$ifdef BSD}
|
|
SO_REUSEPORT = sockets.SO_REUSEPORT;
|
|
{$endif}
|
|
SO_TYPE = sockets.SO_TYPE;
|
|
SO_ERROR = sockets.SO_ERROR;
|
|
SO_DONTROUTE = sockets.SO_DONTROUTE;
|
|
SO_BROADCAST = sockets.SO_BROADCAST;
|
|
SO_SNDBUF = sockets.SO_SNDBUF;
|
|
SO_RCVBUF = sockets.SO_RCVBUF;
|
|
SO_KEEPALIVE = sockets.SO_KEEPALIVE;
|
|
SO_OOBINLINE = sockets.SO_OOBINLINE;
|
|
SO_LINGER = sockets.SO_LINGER;
|
|
SO_RCVLOWAT = sockets.SO_RCVLOWAT;
|
|
SO_SNDLOWAT = sockets.SO_SNDLOWAT;
|
|
SO_RCVTIMEO = sockets.SO_RCVTIMEO;
|
|
SO_SNDTIMEO = sockets.SO_SNDTIMEO;
|
|
{$IFDEF BSD}
|
|
{$IFNDEF OPENBSD}
|
|
{$IFDEF DARWIN}
|
|
SO_NOSIGPIPE = $1022;
|
|
{$ELSE}
|
|
SO_NOSIGPIPE = $800;
|
|
{$ENDIF}
|
|
{$ENDIF}
|
|
{$ENDIF}
|
|
// we use Linux default here
|
|
SOMAXCONN = 128;
|
|
|
|
IPV6_UNICAST_HOPS = sockets.IPV6_UNICAST_HOPS;
|
|
IPV6_MULTICAST_IF = sockets.IPV6_MULTICAST_IF;
|
|
IPV6_MULTICAST_HOPS = sockets.IPV6_MULTICAST_HOPS;
|
|
IPV6_MULTICAST_LOOP = sockets.IPV6_MULTICAST_LOOP;
|
|
IPV6_JOIN_GROUP = sockets.IPV6_JOIN_GROUP;
|
|
IPV6_LEAVE_GROUP = sockets.IPV6_LEAVE_GROUP;
|
|
|
|
MSG_OOB = sockets.MSG_OOB; // Process out-of-band data.
|
|
MSG_PEEK = sockets.MSG_PEEK; // Peek at incoming messages.
|
|
|
|
{$ifdef BSD}
|
|
{$ifndef OpenBSD}
|
|
// Works under MAC OS X and FreeBSD, but is undocumented, so FPC doesn't include it
|
|
MSG_NOSIGNAL = $20000; // Do not generate SIGPIPE.
|
|
{$else}
|
|
MSG_NOSIGNAL = $400;
|
|
{$endif}
|
|
{$else}
|
|
{$ifdef SUNOS}
|
|
MSG_NOSIGNAL = $20000; // Do not generate SIGPIPE.
|
|
{$else}
|
|
MSG_NOSIGNAL = sockets.MSG_NOSIGNAL; // Do not generate SIGPIPE.
|
|
{$endif}
|
|
{$endif}
|
|
|
|
{ TCP options. }
|
|
TCP_NODELAY = $0001;
|
|
|
|
{ Address families. }
|
|
AF_UNSPEC = 0; { unspecified }
|
|
AF_LOCAL = 1;
|
|
AF_INET = 2; { internetwork: UDP, TCP, etc. }
|
|
AF_UNIX = AF_LOCAL;
|
|
AF_MAX = 24;
|
|
|
|
{ Protocol families, same as address families for now. }
|
|
PF_UNSPEC = AF_UNSPEC;
|
|
PF_INET = AF_INET;
|
|
PF_MAX = AF_MAX;
|
|
|
|
const
|
|
WSAEINTR = ESysEINTR;
|
|
WSAEBADF = ESysEBADF;
|
|
WSAEACCES = ESysEACCES;
|
|
WSAEFAULT = ESysEFAULT;
|
|
WSAEINVAL = ESysEINVAL;
|
|
WSAEMFILE = ESysEMFILE;
|
|
WSAEWOULDBLOCK = ESysEWOULDBLOCK; // =WSATRY_AGAIN/ESysEAGAIN on POSIX
|
|
WSAEINPROGRESS = ESysEINPROGRESS;
|
|
WSAEALREADY = ESysEALREADY;
|
|
WSATRY_AGAIN = ESysEAGAIN;
|
|
WSAENOTSOCK = ESysENOTSOCK;
|
|
WSAEDESTADDRREQ = ESysEDESTADDRREQ;
|
|
WSAEMSGSIZE = ESysEMSGSIZE;
|
|
WSAEPROTOTYPE = ESysEPROTOTYPE;
|
|
WSAENOPROTOOPT = ESysENOPROTOOPT;
|
|
WSAEPROTONOSUPPORT = ESysEPROTONOSUPPORT;
|
|
WSAESOCKTNOSUPPORT = ESysESOCKTNOSUPPORT;
|
|
WSAEOPNOTSUPP = ESysEOPNOTSUPP;
|
|
WSAEPFNOSUPPORT = ESysEPFNOSUPPORT;
|
|
WSAEAFNOSUPPORT = ESysEAFNOSUPPORT;
|
|
WSAEADDRINUSE = ESysEADDRINUSE;
|
|
WSAEADDRNOTAVAIL = ESysEADDRNOTAVAIL;
|
|
WSAENETDOWN = ESysENETDOWN;
|
|
WSAENETUNREACH = ESysENETUNREACH;
|
|
WSAENETRESET = ESysENETRESET;
|
|
WSAECONNABORTED = ESysECONNABORTED;
|
|
WSAECONNRESET = ESysECONNRESET;
|
|
WSAENOBUFS = ESysENOBUFS;
|
|
WSAEISCONN = ESysEISCONN;
|
|
WSAENOTCONN = ESysENOTCONN;
|
|
WSAESHUTDOWN = ESysESHUTDOWN;
|
|
WSAETOOMANYREFS = ESysETOOMANYREFS;
|
|
WSAETIMEDOUT = ESysETIMEDOUT;
|
|
WSAECONNREFUSED = ESysECONNREFUSED;
|
|
WSAELOOP = ESysELOOP;
|
|
WSAENAMETOOLONG = ESysENAMETOOLONG;
|
|
WSAEHOSTDOWN = ESysEHOSTDOWN;
|
|
WSAEHOSTUNREACH = ESysEHOSTUNREACH;
|
|
WSAENOTEMPTY = ESysENOTEMPTY;
|
|
WSAEPROCLIM = -1;
|
|
WSAEUSERS = ESysEUSERS;
|
|
WSAEDQUOT = ESysEDQUOT;
|
|
WSAESTALE = ESysESTALE;
|
|
WSAEREMOTE = ESysEREMOTE;
|
|
WSASYSNOTREADY = -2;
|
|
WSAVERNOTSUPPORTED = -3;
|
|
WSANOTINITIALISED = -4;
|
|
WSAEDISCON = -5;
|
|
WSAHOST_NOT_FOUND = 1;
|
|
WSANO_RECOVERY = 3;
|
|
WSANO_DATA = -6;
|
|
|
|
{$else FPC} // Kylix3 definitions:
|
|
|
|
type
|
|
TInAddr6 = packed record
|
|
case byte of
|
|
0: (u6_addr8 : array[0..15] of byte);
|
|
1: (u6_addr16 : array[0..7] of Word);
|
|
2: (u6_addr32 : array[0..3] of Cardinal);
|
|
3: (s6_addr8 : array[0..15] of shortint);
|
|
4: (s6_addr : array[0..15] of shortint);
|
|
5: (s6_addr16 : array[0..7] of smallint);
|
|
6: (s6_addr32 : array[0..3] of LongInt);
|
|
end;
|
|
PInAddr6 = ^TInAddr6;
|
|
|
|
TSockAddrIn6 = packed Record
|
|
sin6_family : sa_family_t;
|
|
sin6_port : word;
|
|
sin6_flowinfo : cardinal;
|
|
sin6_addr : TInAddr6;
|
|
sin6_scope_id : cardinal;
|
|
end;
|
|
|
|
const
|
|
WSAEINTR = EINTR;
|
|
WSATRY_AGAIN = EAGAIN;
|
|
WSAENETDOWN = ENETDOWN;
|
|
WSAECONNABORTED = ECONNABORTED;
|
|
WSAECONNRESET = ECONNRESET;
|
|
WSAEWOULDBLOCK = EWOULDBLOCK;
|
|
WSAEPROTONOSUPPORT = EPROTONOSUPPORT;
|
|
WSAHOST_NOT_FOUND = HOST_NOT_FOUND;
|
|
WSAETIMEDOUT = ETIMEDOUT;
|
|
WSAEMFILE = EMFILE;
|
|
|
|
{$endif FPC}
|
|
|
|
|
|
const
|
|
IPPROTO_IP = 0; { Dummy }
|
|
IPPROTO_ICMP = 1; { Internet Control Message Protocol }
|
|
IPPROTO_IGMP = 2; { Internet Group Management Protocol}
|
|
IPPROTO_TCP = 6; { TCP }
|
|
IPPROTO_UDP = 17; { User Datagram Protocol }
|
|
IPPROTO_IPV6 = 41;
|
|
IPPROTO_ICMPV6 = 58;
|
|
IPPROTO_RM = 113;
|
|
|
|
IPPROTO_RAW = 255;
|
|
IPPROTO_MAX = 256;
|
|
|
|
AF_INET6 = 10; { Internetwork Version 6 }
|
|
PF_INET6 = AF_INET6;
|
|
|
|
SOCK_STREAM = 1; { stream socket }
|
|
SOCK_DGRAM = 2; { datagram socket }
|
|
SOCK_RAW = 3; { raw-protocol interface }
|
|
SOCK_RDM = 4; { reliably-delivered message }
|
|
SOCK_SEQPACKET = 5; { sequenced packet stream }
|
|
|
|
type
|
|
TIP_mreq = record
|
|
imr_multiaddr: TInAddr; // IP multicast address of group
|
|
imr_interface: TInAddr; // local IP address of interface
|
|
end;
|
|
|
|
TIPv6_mreq = record
|
|
ipv6mr_multiaddr: TInAddr6; // IPv6 multicast address.
|
|
ipv6mr_interface: integer; // Interface index.
|
|
end;
|
|
|
|
const
|
|
INADDR_ANY = $00000000;
|
|
INADDR_LOOPBACK = $7F000001;
|
|
INADDR_BROADCAST = $FFFFFFFF;
|
|
INADDR_NONE = $FFFFFFFF;
|
|
ADDR_ANY = INADDR_ANY;
|
|
INVALID_SOCKET = TSocket(NOT(0));
|
|
SOCKET_ERROR = -1;
|
|
|
|
|
|
type
|
|
{ Structure used for manipulating linger option. }
|
|
PLinger = ^TLinger;
|
|
TLinger = packed record
|
|
l_onoff: integer;
|
|
l_linger: integer;
|
|
end;
|
|
|
|
const
|
|
WSADESCRIPTION_LEN = 256;
|
|
WSASYS_STATUS_LEN = 128;
|
|
|
|
type
|
|
PWSAData = ^TWSAData;
|
|
TWSAData = packed record
|
|
wVersion: Word;
|
|
wHighVersion: Word;
|
|
szDescription: array[0..WSADESCRIPTION_LEN] of Char;
|
|
szSystemStatus: array[0..WSASYS_STATUS_LEN] of Char;
|
|
iMaxSockets: Word;
|
|
iMaxUdpDg: Word;
|
|
lpVendorInfo: PChar;
|
|
end;
|
|
|
|
function IN6_IS_ADDR_UNSPECIFIED(const a: PInAddr6): boolean;
|
|
function IN6_IS_ADDR_LOOPBACK(const a: PInAddr6): boolean;
|
|
function IN6_IS_ADDR_LINKLOCAL(const a: PInAddr6): boolean;
|
|
function IN6_IS_ADDR_SITELOCAL(const a: PInAddr6): boolean;
|
|
function IN6_IS_ADDR_MULTICAST(const a: PInAddr6): boolean;
|
|
function IN6_ADDR_EQUAL(const a: PInAddr6; const b: PInAddr6):boolean;
|
|
procedure SET_IN6_IF_ADDR_ANY (const a: PInAddr6);
|
|
procedure SET_LOOPBACK_ADDR6 (const a: PInAddr6);
|
|
|
|
var
|
|
in6addr_any, in6addr_loopback : TInAddr6;
|
|
|
|
{$ifdef FPC} // some functions inlined redirection to Sockets.pp
|
|
|
|
procedure FD_CLR(Socket: TSocket; var FDSet: TFDSet); inline;
|
|
function FD_ISSET(Socket: TSocket; var FDSet: TFDSet): Boolean; inline;
|
|
procedure FD_SET(Socket: TSocket; var FDSet: TFDSet); inline;
|
|
procedure FD_ZERO(var FDSet: TFDSet); inline;
|
|
|
|
function ResolveIPToName(const IP: string; Family,SockProtocol,SockType: integer): string;
|
|
function ResolvePort(const Port: string; Family,SockProtocol,SockType: integer): Word;
|
|
|
|
function fpbind(s:cint; addrx: psockaddr; addrlen: tsocklen): cint; inline;
|
|
function fplisten(s:cint; backlog: cint): cint; inline;
|
|
function fprecv(s:cint; buf: pointer; len: size_t; Flags: cint): ssize_t; inline;
|
|
function fpsend(s:cint; msg:pointer; len:size_t; flags:cint): ssize_t; inline;
|
|
|
|
{$endif FPC}
|
|
|
|
const
|
|
// we assume that the Posix OS has IP6 compatibility
|
|
SockEnhancedApi = true;
|
|
SockWship6Api = true;
|
|
|
|
type
|
|
PVarSin = ^TVarSin;
|
|
TVarSin = packed record
|
|
{$ifdef SOCK_HAS_SINLEN}
|
|
sin_len: cuchar;
|
|
{$endif}
|
|
case integer of
|
|
0: (AddressFamily: sa_family_t);
|
|
1: (
|
|
case sin_family: sa_family_t of
|
|
AF_INET: (sin_port: word;
|
|
sin_addr: TInAddr;
|
|
sin_zero: array[0..7] of Char);
|
|
AF_INET6:(sin6_port: word; // see sockaddr_in6
|
|
sin6_flowinfo: cardinal;
|
|
sin6_addr: TInAddr6;
|
|
sin6_scope_id: cardinal);
|
|
AF_UNIX: (sun_path: array[0..{$ifdef SOCK_HAS_SINLEN}103{$else}107{$endif}] of Char);
|
|
);
|
|
end;
|
|
|
|
function SizeOfVarSin(sin: TVarSin): integer;
|
|
|
|
function WSAStartup(wVersionRequired: Word; var WSData: TWSAData): Integer;
|
|
function WSACleanup: Integer;
|
|
function WSAGetLastError: Integer;
|
|
function GetHostName: string;
|
|
function Shutdown(s: TSocket; how: Integer): Integer;
|
|
function SetSockOpt(s: TSocket; level,optname: Integer; optval: pointer;
|
|
optlen: Integer): Integer;
|
|
function GetSockOpt(s: TSocket; level,optname: Integer; optval: pointer;
|
|
var optlen: Integer): Integer;
|
|
function SendTo(s: TSocket; Buf: pointer; len,flags: Integer; addrto: TVarSin): Integer;
|
|
function RecvFrom(s: TSocket; Buf: pointer; len,flags: Integer; var from: TVarSin): Integer;
|
|
function ntohs(netshort: word): word;
|
|
function ntohl(netlong: cardinal): cardinal;
|
|
function Listen(s: TSocket; backlog: Integer): Integer;
|
|
function IoctlSocket(s: TSocket; cmd: DWORD; var arg: integer): Integer;
|
|
function htons(hostshort: word): word;
|
|
function htonl(hostlong: cardinal): cardinal;
|
|
function GetSockName(s: TSocket; var name: TVarSin): Integer;
|
|
function GetPeerName(s: TSocket; var name: TVarSin): Integer;
|
|
function Connect(s: TSocket; const name: TVarSin): Integer;
|
|
function CloseSocket(s: TSocket): Integer;
|
|
function Bind(s: TSocket; const addr: TVarSin): Integer;
|
|
function Accept(s: TSocket; var addr: TVarSin): TSocket;
|
|
function Socket(af,Struc,Protocol: Integer): TSocket;
|
|
function Select(nfds: Integer; readfds,writefds,exceptfds: PFDSet;
|
|
timeout: PTimeVal): Longint;
|
|
|
|
function IsNewApi(Family: integer): Boolean;
|
|
function SetVarSin(var Sin: TVarSin; const IP,Port: string;
|
|
Family,SockProtocol,SockType: integer; PreferIP4: Boolean): integer;
|
|
function GetSinIP(const Sin: TVarSin): string;
|
|
function GetSinPort(const Sin: TVarSin): Integer;
|
|
procedure ResolveNameToIP(const Name: AnsiString; Family, SockProtocol, SockType: integer;
|
|
IPList: TStrings; IPListClear: boolean = true);
|
|
|
|
const
|
|
// poll() flag when there is data to read
|
|
POLLIN = $001;
|
|
// poll() flag when there is urgent data to read
|
|
POLLPRI = $002;
|
|
// poll() flag when writing now will not block
|
|
POLLOUT = $004;
|
|
// poll() flag error condition (always implicitly polled for)
|
|
POLLERR = $008;
|
|
// poll() flag hung up (always implicitly polled for)
|
|
POLLHUP = $010;
|
|
// poll() flag invalid polling request (always implicitly polled for)
|
|
POLLNVAL = $020;
|
|
// poll() flag when normal data may be read
|
|
POLLRDNORM = $040;
|
|
// poll() flag when priority data may be read
|
|
POLLRDBAND = $080;
|
|
// poll() flag when writing now will not block
|
|
POLLWRNORM = $100;
|
|
// poll() flag when priority data may be written
|
|
POLLWRBAND = $200;
|
|
// poll() flag extension for Linux
|
|
POLLMSG = $400;
|
|
|
|
type
|
|
/// polling request data structure for poll()
|
|
TPollFD = {packed} record
|
|
/// file descriptor to poll
|
|
fd: integer;
|
|
/// types of events poller cares about
|
|
// - mainly POLLIN and/or POLLOUT
|
|
events: Smallint;
|
|
/// types of events that actually occurred
|
|
// - caller could just reset revents := 0 to reuse the structure
|
|
revents: Smallint;
|
|
end;
|
|
PPollFD = ^TPollFD;
|
|
TPollFDDynArray = array of TPollFD;
|
|
|
|
/// Poll the file descriptors described by the nfds structures starting at fds
|
|
// - if TIMEOUT is nonzero and not -1, allow TIMEOUT milliseconds for
|
|
// an event to occur; if TIMEOUT is -1, block until an event occurs
|
|
// - returns the number of file descriptors with events, zero if timed out,
|
|
// or -1 for errors
|
|
function poll(fds: PPollFD; nfds, timeout: integer): integer;
|
|
|
|
{$ifdef Linux}
|
|
const
|
|
// associated file is available for read operations
|
|
EPOLLIN = $01;
|
|
// urgent data available for read operations
|
|
EPOLLPRI = $02;
|
|
// associated file is available for write operations
|
|
EPOLLOUT = $04;
|
|
// error condition happened on the associated file descriptor
|
|
EPOLLERR = $08;
|
|
// hang up happened on the associated file descriptor
|
|
EPOLLHUP = $10;
|
|
// sets the One-Shot behaviour for the associated file descriptor
|
|
// - i.e. after an event is pulled out, the file descriptor is disabled
|
|
EPOLLONESHOT = $40000000;
|
|
// sets the Edge-Triggered (ET) behaviour for the associated file descriptor
|
|
EPOLLET = $80000000;
|
|
|
|
EPOLL_CTL_ADD = 1;
|
|
EPOLL_CTL_DEL = 2;
|
|
EPOLL_CTL_MOD = 3;
|
|
|
|
type
|
|
/// application-level data structure for epoll
|
|
TEPollData = record
|
|
case integer of
|
|
0: (ptr: pointer);
|
|
1: (fd: integer);
|
|
2: (u32: cardinal);
|
|
3: (u64: Int64);
|
|
4: (obj: TObject);
|
|
end;
|
|
PEPollData = ^TEPollData;
|
|
|
|
/// epoll descriptor data structure
|
|
TEPollEvent = packed record
|
|
events: cardinal;
|
|
data: TEpollData;
|
|
end;
|
|
PEPollEvent = ^TEPollEvent;
|
|
TEPollEventDynArray = array of TEPollEvent;
|
|
|
|
/// open an epoll file descriptor
|
|
function epoll_create(size: integer): integer;
|
|
{$ifdef FPC}inline;{$endif} {$ifdef KYLIX3}cdecl;{$endif}
|
|
|
|
/// control interface for an epoll descriptor
|
|
function epoll_ctl(epfd, op, fd: integer; event: PEPollEvent): integer;
|
|
{$ifdef FPC}inline;{$endif} {$ifdef KYLIX3}cdecl;{$endif}
|
|
|
|
/// wait for an I/O event on an epoll file descriptor
|
|
function epoll_wait(epfd: integer; events: PEPollEvent; maxevents, timeout: integer): integer;
|
|
{$ifdef FPC}inline;{$endif} {$ifdef KYLIX3}cdecl;{$endif}
|
|
|
|
/// finalize an epoll file descriptor
|
|
// - call fpclose/libc.close
|
|
function epoll_close(epfd: integer): integer;
|
|
{$endif Linux}
|
|
|
|
var
|
|
SynSockCS: TRTLCriticalSection;
|
|
|
|
implementation
|
|
|
|
{$ifdef USELIBC}
|
|
{$i SynFPCSockLIBC.inc}
|
|
{$endif}
|
|
|
|
function IN6_IS_ADDR_UNSPECIFIED(const a: PInAddr6): boolean;
|
|
begin
|
|
result := ((a^.u6_addr32[0]=0) and (a^.u6_addr32[1]=0) and
|
|
(a^.u6_addr32[2]=0) and (a^.u6_addr32[3]=0));
|
|
end;
|
|
|
|
function IN6_IS_ADDR_LOOPBACK(const a: PInAddr6): boolean;
|
|
begin
|
|
result := ((a^.u6_addr32[0]=0) and (a^.u6_addr32[1]=0) and
|
|
(a^.u6_addr32[2]=0) and
|
|
(a^.u6_addr8[12]=0) and (a^.u6_addr8[13]=0) and
|
|
(a^.u6_addr8[14]=0) and (a^.u6_addr8[15]=1));
|
|
end;
|
|
|
|
function IN6_IS_ADDR_LINKLOCAL(const a: PInAddr6): boolean;
|
|
begin
|
|
result := ((a^.u6_addr8[0]=$FE) and (a^.u6_addr8[1]=$80));
|
|
end;
|
|
|
|
function IN6_IS_ADDR_SITELOCAL(const a: PInAddr6): boolean;
|
|
begin
|
|
result := ((a^.u6_addr8[0]=$FE) and (a^.u6_addr8[1]=$C0));
|
|
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 := 'Synopse Sockets';
|
|
szSystemStatus := 'Linux';
|
|
iMaxSockets := 32768;
|
|
iMaxUdpDg := 8192;
|
|
end;
|
|
result := 0;
|
|
end;
|
|
|
|
function WSACleanup: Integer;
|
|
begin
|
|
result := 0;
|
|
end;
|
|
|
|
function WSAGetLastError: Integer;
|
|
begin
|
|
result := {$ifdef KYLIX3}errno{$else}fpGetErrno{$endif};
|
|
end;
|
|
|
|
{$ifdef FPC}
|
|
|
|
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;
|
|
|
|
{$ifndef USELIBC}
|
|
function fpbind(s:cint; addrx: psockaddr; addrlen: tsocklen): cint;
|
|
begin
|
|
result := sockets.fpbind(s, addrx, addrlen);
|
|
end;
|
|
|
|
function fplisten(s:cint; backlog : cint): cint;
|
|
begin
|
|
result := sockets.fplisten(s, backlog);
|
|
end;
|
|
|
|
function fprecv(s:cint; buf: pointer; len: size_t; Flags: cint): ssize_t;
|
|
begin
|
|
result := sockets.fprecv(s, buf, len, Flags);
|
|
end;
|
|
|
|
function fpsend(s:cint; msg:pointer; len:size_t; flags:cint): ssize_t;
|
|
begin
|
|
result := sockets.fpsend(s, msg, len, flags);
|
|
end;
|
|
{$endif USELIBC}
|
|
|
|
{$endif FPC}
|
|
|
|
function SizeOfVarSin(sin: TVarSin): integer;
|
|
begin
|
|
case sin.sin_family of
|
|
AF_INET: result := SizeOf(TSockAddrIn);
|
|
AF_INET6: result := SizeOf(TSockAddrIn6);
|
|
AF_UNIX: result := SizeOf(sockaddr_un);
|
|
else result := 0;
|
|
end;
|
|
end;
|
|
|
|
{=============================================================================}
|
|
|
|
function Bind(s: TSocket; const addr: TVarSin): Integer;
|
|
begin
|
|
{$ifdef KYLIX3}
|
|
if LibC.Bind(s,PSockAddr(@addr)^,SizeOfVarSin(addr))=0 then
|
|
{$else}
|
|
if fpBind(s,@addr,SizeOfVarSin(addr))=0 then
|
|
{$endif}
|
|
result := 0 else
|
|
result := SOCKET_ERROR;
|
|
end;
|
|
|
|
function Connect(s: TSocket; const name: TVarSin): Integer;
|
|
begin
|
|
{$ifdef KYLIX3}
|
|
if LibC.Connect(s,PSockAddr(@name)^,SizeOfVarSin(name))=0 then
|
|
{$else}
|
|
if fpConnect(s,@name,SizeOfVarSin(name))=0 then
|
|
{$endif}
|
|
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);
|
|
{$ifdef KYLIX3}
|
|
result := LibC.getsockname(s,PSockAddr(@name)^,PSocketLength(@len)^);
|
|
{$else}
|
|
result := fpGetSockName(s,@name,@len);
|
|
{$endif}
|
|
end;
|
|
|
|
function GetPeerName(s: TSocket; var name: TVarSin): Integer;
|
|
var len: integer;
|
|
begin
|
|
len := SizeOf(name);
|
|
FillChar(name,len,0);
|
|
{$ifdef KYLIX3}
|
|
result := LibC.getpeername(s,PSockAddr(@name)^,PSocketLength(@len)^);
|
|
{$else}
|
|
result := fpGetPeerName(s,@name,@len);
|
|
{$endif}
|
|
end;
|
|
|
|
function GetHostName: string;
|
|
{$ifdef KYLIX3}
|
|
var tmp: array[byte] of char;
|
|
begin
|
|
LibC.gethostname(tmp,sizeof(tmp)-1);
|
|
result := tmp;
|
|
end;
|
|
{$else}
|
|
begin
|
|
result := unix.GetHostName;
|
|
end;
|
|
{$endif}
|
|
|
|
function SendTo(s: TSocket; Buf: pointer; len,flags: Integer; addrto: TVarSin): Integer;
|
|
begin
|
|
{$ifdef KYLIX3}
|
|
result := LibC.sendto(s,Buf^,len,flags,PSockAddr(@addrto)^,SizeOfVarSin(addrto));
|
|
{$else}
|
|
result := fpSendTo(s,pointer(Buf),len,flags,@addrto,SizeOfVarSin(addrto));
|
|
{$endif}
|
|
end;
|
|
|
|
function RecvFrom(s: TSocket; Buf: pointer; len,flags: Integer; var from: TVarSin): Integer;
|
|
var x: integer;
|
|
begin
|
|
x := SizeOf(from);
|
|
{$ifdef KYLIX3}
|
|
result := LibC.recvfrom(s,Buf^,len,flags,PSockAddr(@from),PSocketLength(@x));
|
|
{$else}
|
|
result := fpRecvFrom(s,pointer(Buf),len,flags,@from,@x);
|
|
{$endif}
|
|
end;
|
|
|
|
function Accept(s: TSocket; var addr: TVarSin): TSocket;
|
|
var x: integer;
|
|
begin
|
|
x := SizeOf(addr);
|
|
{$ifdef KYLIX3}
|
|
result := LibC.accept(s,PSockAddr(@addr),PSocketLength(@x));
|
|
{$else}
|
|
result := fpAccept(s,@addr,@x);
|
|
{$endif}
|
|
end;
|
|
|
|
function Shutdown(s: TSocket; how: Integer): Integer;
|
|
begin
|
|
{$ifdef KYLIX3}
|
|
result := LibC.shutdown(s,how);
|
|
{$else}
|
|
result := fpShutdown(s,how);
|
|
{$endif}
|
|
end;
|
|
|
|
function SetSockOpt(s: TSocket; level,optname: Integer; optval: pointer;
|
|
optlen: Integer): Integer;
|
|
begin
|
|
result := {$ifdef KYLIX3}LibC.setsockopt{$else}fpsetsockopt{$endif}(
|
|
s,level,optname,optval ,optlen);
|
|
end;
|
|
|
|
function GetSockOpt(s: TSocket; level,optname: Integer; optval: pointer;
|
|
var optlen: Integer): Integer;
|
|
begin
|
|
{$ifdef KYLIX3}
|
|
result := LibC.getsockopt(s,level,optname,pointer(optval),socklen_t(optlen));
|
|
{$else}
|
|
result := fpgetsockopt(s,level,optname,pointer(optval),@optlen);
|
|
{$endif}
|
|
end;
|
|
|
|
function ntohs(netshort: word): word;
|
|
begin
|
|
result := {$ifdef KYLIX3}LibC{$else}sockets{$endif}.ntohs(NetShort);
|
|
end;
|
|
|
|
function ntohl(netlong: cardinal): cardinal;
|
|
begin
|
|
result := {$ifdef KYLIX3}LibC{$else}sockets{$endif}.ntohl(NetLong);
|
|
end;
|
|
|
|
function Listen(s: TSocket; backlog: Integer): Integer;
|
|
begin
|
|
if {$ifdef KYLIX3}LibC.listen{$else}fpListen{$endif}(s,backlog)=0 then
|
|
result := 0 else
|
|
result := SOCKET_ERROR;
|
|
end;
|
|
|
|
function IoctlSocket(s: TSocket; cmd: DWORD; var arg: integer): Integer;
|
|
begin
|
|
{$ifdef KYLIX3}
|
|
result := ioctl(s,cmd,@arg);
|
|
{$else}
|
|
result := fpIoctl(s,cmd,@arg);
|
|
{$endif}
|
|
end;
|
|
|
|
function htons(hostshort: word): word;
|
|
begin
|
|
result := {$ifdef KYLIX3}LibC{$else}sockets{$endif}.htons(hostshort);
|
|
end;
|
|
|
|
function htonl(hostlong: cardinal): cardinal;
|
|
begin
|
|
result := {$ifdef KYLIX3}LibC{$else}sockets{$endif}.htonl(hostlong);
|
|
end;
|
|
|
|
function CloseSocket(s: TSocket): Integer;
|
|
begin
|
|
{$ifdef KYLIX3}
|
|
result := Libc.__close(s);
|
|
{$else}
|
|
result := sockets.CloseSocket(s);
|
|
{$endif}
|
|
end;
|
|
|
|
function Socket(af,Struc,Protocol: Integer): TSocket;
|
|
{$IF defined(BSD) AND NOT defined(OpenBSD)}
|
|
var
|
|
on_off: integer;
|
|
{$ENDIF}
|
|
begin
|
|
result := {$ifdef KYLIX3}LibC.socket{$else}fpSocket{$endif}(af,struc,protocol);
|
|
// ##### Patch for BSD to avoid "Project XXX raised exception class 'External: SIGPIPE'" error.
|
|
{$IF defined(BSD) AND NOT defined(OpenBSD)}
|
|
if result <> INVALID_SOCKET then begin
|
|
on_off := 1;
|
|
fpSetSockOpt(result,integer(SOL_SOCKET),integer(SO_NOSIGPIPE),@on_off,SizeOf(integer));
|
|
end;
|
|
{$ENDIF}
|
|
end;
|
|
|
|
function Select(nfds: Integer; readfds,writefds,exceptfds: PFDSet;
|
|
timeout: PTimeVal): Longint;
|
|
begin
|
|
result := {$ifdef KYLIX3}LibC.select{$else}fpSelect{$endif}(
|
|
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 GetSinPort(const Sin: TVarSin): Integer;
|
|
begin
|
|
if (Sin.sin_family=AF_INET6) then
|
|
result := ntohs(Sin.sin6_port) else
|
|
result := ntohs(Sin.sin_port);
|
|
end;
|
|
|
|
function poll(fds: PPollFD; nfds, timeout: integer): integer;
|
|
begin
|
|
{$ifdef KYLIX3}
|
|
result := libc.poll(pointer(fds),nfds,timeout);
|
|
{$else}
|
|
result := fppoll(pointer(fds),nfds,timeout);
|
|
{$endif}
|
|
end;
|
|
|
|
{$ifdef KYLIX3} // those functions only use the new API
|
|
|
|
function SetVarSin(var Sin: TVarSin; const IP,Port: string;
|
|
Family,SockProtocol,SockType: integer; PreferIP4: Boolean): integer;
|
|
function GetAddr(const IP, port: string; var Hints: addrinfo; var Sin: TVarSin): integer;
|
|
var Addr: PAddressInfo;
|
|
begin
|
|
Addr := nil;
|
|
try
|
|
FillChar(Sin, Sizeof(Sin), 0);
|
|
if Hints.ai_socktype=SOCK_RAW then begin
|
|
Hints.ai_socktype := 0;
|
|
Hints.ai_protocol := 0;
|
|
result := LibC.getaddrinfo(pointer(IP), nil, @Hints, Addr);
|
|
end else
|
|
if (IP=cAnyHost) or (IP=c6AnyHost) then begin
|
|
Hints.ai_flags := AI_PASSIVE;
|
|
result := LibC.getaddrinfo(nil, pointer(Port), @Hints, Addr);
|
|
end else
|
|
if (IP = cLocalhost) or (IP = c6Localhost) then
|
|
result := LibC.getaddrinfo(nil, pointer(Port), @Hints, Addr) else
|
|
result := LibC.getaddrinfo(pointer(IP), pointer(Port), @Hints, Addr);
|
|
if (Result=0) and (Addr<>nil) then
|
|
Move(Addr^.ai_addr^, Sin, Addr^.ai_addrlen);
|
|
finally
|
|
if Assigned(Addr) then
|
|
LibC.freeaddrinfo(Addr);
|
|
end;
|
|
end;
|
|
|
|
var Hints1, Hints2: addrinfo;
|
|
Sin1, Sin2: TVarSin;
|
|
TwoPass: boolean;
|
|
begin
|
|
FillChar(Hints1, Sizeof(Hints1), 0);
|
|
FillChar(Hints2, Sizeof(Hints2), 0);
|
|
TwoPass := False;
|
|
if Family=AF_UNSPEC then begin
|
|
if PreferIP4 then begin
|
|
Hints1.ai_family := AF_INET;
|
|
Hints2.ai_family := AF_INET6;
|
|
TwoPass := True;
|
|
end else begin
|
|
Hints1.ai_family := AF_INET6;
|
|
Hints2.ai_family := AF_INET;
|
|
TwoPass := True;
|
|
end;
|
|
end else
|
|
Hints1.ai_family := Family;
|
|
Hints1.ai_socktype := SockType;
|
|
Hints1.ai_protocol := SockProtocol;
|
|
Hints2.ai_socktype := SockType;
|
|
Hints2.ai_protocol := SockProtocol;
|
|
result := GetAddr(IP, Port, Hints1, Sin1);
|
|
if result=0 then
|
|
sin := sin1 else
|
|
if TwoPass then begin
|
|
result := GetAddr(IP, Port, Hints2, Sin2);
|
|
if result=0 then
|
|
sin := sin2;
|
|
end;
|
|
end;
|
|
|
|
function GetSinIP(const Sin: TVarSin): string;
|
|
var host: array[0..NI_MAXHOST] of char;
|
|
serv: array[0..NI_MAXSERV] of char;
|
|
r: integer;
|
|
begin
|
|
r := LibC.getnameinfo(PSockAddr(@sin)^,SizeOfVarSin(sin), host,NI_MAXHOST,
|
|
serv,NI_MAXSERV, NI_NUMERICHOST+NI_NUMERICSERV);
|
|
if r=0 then
|
|
result := host else
|
|
result := '';
|
|
end;
|
|
|
|
procedure ResolveNameToIP(const Name: AnsiString; Family, SockProtocol, SockType: integer;
|
|
IPList: TStrings; IPListClear: boolean);
|
|
var
|
|
Hints: TAddressInfo;
|
|
Addr: PAddressInfo;
|
|
AddrNext: PAddressInfo;
|
|
r, prev: integer;
|
|
host, serv: string;
|
|
hostlen, servlen: integer;
|
|
begin
|
|
if IPListClear then
|
|
IPList.Clear;
|
|
Addr := nil;
|
|
try // we force to find TCP/IP
|
|
FillChar(Hints, Sizeof(Hints), 0);
|
|
Hints.ai_family := Family;
|
|
Hints.ai_protocol := SockProtocol;
|
|
Hints.ai_socktype := SockType;
|
|
r := LibC.getaddrinfo(pointer(Name), nil, @Hints, Addr);
|
|
if r=0 then begin
|
|
AddrNext := Addr;
|
|
while not(AddrNext=nil) do begin
|
|
if not(((Family=AF_INET6) and (AddrNext^.ai_family=AF_INET))
|
|
or ((Family=AF_INET) and (AddrNext^.ai_family=AF_INET6))) then begin
|
|
hostlen := NI_MAXHOST;
|
|
servlen := NI_MAXSERV;
|
|
setlength(host,hostlen);
|
|
setlength(serv,servlen);
|
|
r := LibC.getnameinfo(AddrNext^.ai_addr^, AddrNext^.ai_addrlen,
|
|
PChar(host), hostlen, PChar(serv), servlen,
|
|
NI_NUMERICHOST + NI_NUMERICSERV);
|
|
if r=0 then begin
|
|
host := PChar(host);
|
|
IPList.Add(host);
|
|
end;
|
|
end;
|
|
AddrNext := AddrNext^.ai_next;
|
|
end;
|
|
end;
|
|
finally
|
|
if Assigned(Addr) then
|
|
LibC.freeaddrinfo(Addr);
|
|
end;
|
|
if IPList.Count=0 then
|
|
IPList.Add(cAnyHost);
|
|
end;
|
|
|
|
{$else} // FPC version
|
|
|
|
function SetVarSin(var Sin: TVarSin; const 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 TInAddr;
|
|
a6: array[1..1] of TInAddr6;
|
|
he: THostEntry;
|
|
begin
|
|
result := WSAEPROTONOSUPPORT;
|
|
case f of
|
|
AF_INET: begin
|
|
if IP=cAnyHost then begin
|
|
Sin.sin_family := AF_INET;
|
|
result := 0;
|
|
end else begin
|
|
if lowercase(IP)=cLocalHostStr then
|
|
a4[1].s_addr := htonl(INADDR_LOOPBACK) else begin
|
|
a4[1].s_addr := 0;
|
|
result := WSAHOST_NOT_FOUND;
|
|
a4[1] := StrTonetAddr(IP);
|
|
if a4[1].s_addr=INADDR_ANY then
|
|
if GetHostByName(ip,he) then
|
|
a4[1] := HostToNet(he.Addr) else
|
|
Resolvename(ip,a4);
|
|
end;
|
|
if a4[1].s_addr <> INADDR_ANY then begin
|
|
Sin.sin_family := AF_INET;
|
|
sin.sin_addr := a4[1];
|
|
result := 0;
|
|
end;
|
|
end;
|
|
end;
|
|
AF_INET6: begin
|
|
if IP=c6AnyHost then begin
|
|
Sin.sin_family := AF_INET6;
|
|
result := 0;
|
|
end else begin
|
|
if lowercase(IP)=cLocalHostStr then
|
|
SET_LOOPBACK_ADDR6(@a6[1]) else 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);
|
|
end;
|
|
if not IN6_IS_ADDR_UNSPECIFIED(@a6[1]) then begin
|
|
Sin.sin_family := AF_INET6;
|
|
sin.sin6_addr := a6[1];
|
|
result := 0;
|
|
end;
|
|
end;
|
|
end;
|
|
end;
|
|
end;
|
|
begin
|
|
result := 0;
|
|
if (Family=AF_UNIX) then begin
|
|
Sin.AddressFamily := AF_UNIX;
|
|
Move(IP[1],Sin.sun_path,length(IP));
|
|
Sin.sun_path[length(IP)]:=#0;
|
|
exit;
|
|
end;
|
|
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_INET6;
|
|
f1 := AF_INET;
|
|
TwoPass := true;
|
|
end;
|
|
end else
|
|
f1 := Family;
|
|
result := GetAddr(f1);
|
|
if result <> 0 then
|
|
if TwoPass then
|
|
result := GetAddr(f2);
|
|
end;
|
|
|
|
function GetSinIP(const Sin: TVarSin): string;
|
|
begin
|
|
result := '';
|
|
case sin.AddressFamily of
|
|
AF_INET: result := NetAddrToStr(sin.sin_addr);
|
|
AF_INET6: result := NetAddrToStr6(sin.sin6_addr);
|
|
end;
|
|
end;
|
|
|
|
procedure ResolveNameToIP(const Name: AnsiString; Family, SockProtocol, SockType: integer;
|
|
IPList: TStrings; IPListClear: boolean);
|
|
var x,n: integer;
|
|
a4: array[1..255] of in_addr;
|
|
a6: array[1..255] of Tin6_addr;
|
|
he: THostEntry;
|
|
begin
|
|
if IPListClear then
|
|
IPList.Clear;
|
|
if (family=AF_INET) or (family=AF_UNSPEC) then begin
|
|
if lowercase(name)=cLocalHostStr then
|
|
IpList.Add(cLocalHost)
|
|
else if name=cAnyHost then
|
|
IpList.Add(cAnyHost)
|
|
else begin
|
|
a4[1] := StrTonetAddr(name);
|
|
if a4[1].s_addr=INADDR_ANY then
|
|
if GetHostByName(name,he) then begin
|
|
a4[1] := HostToNet(he.Addr);
|
|
x := 1;
|
|
end else
|
|
x := Resolvename(name,a4) else
|
|
x := 1;
|
|
for n := 1 to x do
|
|
IpList.Add(netaddrToStr(a4[n]));
|
|
end;
|
|
end;
|
|
if (family=AF_INET6) or (family=AF_UNSPEC) then begin
|
|
if lowercase(name)=cLocalHostStr then
|
|
IpList.Add(c6LocalHost)
|
|
else if name=c6AnyHost then
|
|
IpList.Add(c6AnyHost)
|
|
else 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;
|
|
end;
|
|
if IPList.Count=0 then
|
|
IPList.Add(cAnyHost);
|
|
end;
|
|
|
|
function ResolvePort(const Port: string; Family,SockProtocol,SockType: integer): Word;
|
|
var ProtoEnt: TProtocolEntry;
|
|
ServEnt: TServiceEntry;
|
|
begin
|
|
result := 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(const IP: string; Family,SockProtocol,SockType: integer): string;
|
|
var n: integer;
|
|
a4: array[1..1] of TInAddr;
|
|
a6: array[1..1] of TInAddr6;
|
|
a: array[1..1] of string;
|
|
begin
|
|
result := IP;
|
|
a4[1] := StrToNetAddr(IP);
|
|
if a4[1].s_addr <> INADDR_ANY then begin
|
|
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;
|
|
|
|
{$endif KYLIX3}
|
|
|
|
{$ifdef Linux} // epoll is Linux-specific
|
|
|
|
{$ifdef FPC} // use Linux.pas wrappers
|
|
function epoll_create(size: integer): integer;
|
|
begin
|
|
result := Linux.epoll_create(size);
|
|
end;
|
|
|
|
function epoll_ctl(epfd, op, fd: integer; event: PEPollEvent): integer;
|
|
begin
|
|
result := Linux.epoll_ctl(epfd, op, fd, pointer(event));
|
|
end;
|
|
|
|
function epoll_wait(epfd: integer; events: PEPollEvent; maxevents, timeout: integer): integer;
|
|
begin
|
|
result := Linux.epoll_wait(epfd, pointer(events), maxevents, timeout);
|
|
end;
|
|
|
|
function epoll_close(epfd: integer): integer;
|
|
begin
|
|
result := fpClose(epfd);
|
|
end;
|
|
{$endif}
|
|
|
|
{$ifdef KYLIX3} // use libc.so wrappers
|
|
function epoll_create; external libcmodulename name 'epoll_create';
|
|
function epoll_ctl; external libcmodulename name 'epoll_ctl';
|
|
function epoll_wait; external libcmodulename name 'epoll_wait';
|
|
|
|
function epoll_close(epfd: integer): integer;
|
|
begin
|
|
result := __close(epfd);
|
|
end;
|
|
{$endif}
|
|
|
|
{$endif Linux}
|
|
|
|
procedure DestroySocketInterface;
|
|
begin
|
|
// nothing to do, since we use either the FPC units, either LibC.pas
|
|
end;
|
|
|
|
initialization
|
|
SET_IN6_IF_ADDR_ANY(@in6addr_any);
|
|
SET_LOOPBACK_ADDR6(@in6addr_loopback);
|
|
InitializeCriticalSection(SynSockCS);
|
|
|
|
finalization
|
|
DeleteCriticalSection(SynSockCS);
|
|
end.
|