{ $Project$ $Workfile$ $Revision$ $DateUTC$ $Id$ This file is part of the Indy (Internet Direct) project, and is offered under the dual-licensing agreement described on the Indy website. (http://www.indyproject.org/) Copyright: (c) 1993-2005, Chad Z. Hower and the Indy Pit Crew. All rights reserved. } { $Log$ } { Rev 1.7 10/26/2004 8:20:04 PM JPMugaas Fixed some oversights with conversion. OOPS!!! Rev 1.6 10/26/2004 8:12:32 PM JPMugaas Now uses TIdStrings and TIdStringList for portability. Rev 1.5 12/06/2004 15:17:20 CCostelloe Restructured to correspond with IdStackWindows, now works. Rev 1.4 07/06/2004 21:31:02 CCostelloe Kylix 3 changes Rev 1.3 4/18/04 10:43:22 PM RLebeau Fixed syntax error Rev 1.2 4/18/04 10:29:46 PM RLebeau Renamed Int64Parts structure to TIdInt64Parts Rev 1.1 4/18/04 2:47:28 PM RLebeau Conversion support for Int64 values Removed WSHToNs(), WSNToHs(), WSHToNL(), and WSNToHL() methods, obsolete Rev 1.0 2004.02.03 3:14:48 PM czhower Move and updates Rev 1.3 10/19/2003 5:35:14 PM BGooijen SetSocketOption Rev 1.2 2003.10.01 9:11:24 PM czhower .Net Rev 1.1 7/5/2003 07:25:50 PM JPMugaas Added functions to the Linux stack which use the new TIdIPAddress record type for IP address parameters. I also fixed a compile bug. Rev 1.0 11/13/2002 08:59:24 AM JPMugaas } unit IdStackLibc; interface {$i IdCompilerDefines.inc} uses Classes, Libc, IdStack, IdStackConsts, IdGlobal, IdStackBSDBase; {$UNDEF LIBCPASS_STRUCT} {$IFDEF KYLIX} {$DEFINE LIBCPASS_STRUCT} {$ENDIF} {$IFDEF DELPHI_CROSS} {$DEFINE LIBCPASS_STRUCT} {$ENDIF} type TIdSocketListLibc = class (TIdSocketList) protected FCount: integer; FFDSet: TFDSet; // class function FDSelect(AReadSet: PFDSet; AWriteSet: PFDSet; AExceptSet: PFDSet; const ATimeout: Integer = IdTimeoutInfinite): integer; function GetItem(AIndex: Integer): TIdStackSocketHandle; override; public procedure Add(AHandle: TIdStackSocketHandle); override; procedure Remove(AHandle: TIdStackSocketHandle); override; function Count: Integer; override; procedure Clear; override; function Clone: TIdSocketList; override; function ContainsSocket(AHandle: TIdStackSocketHandle): boolean; override; procedure GetFDSet(var VSet: TFDSet); procedure SetFDSet(var VSet: TFDSet); class function Select(AReadList: TIdSocketList; AWriteList: TIdSocketList; AExceptList: TIdSocketList; const ATimeout: Integer = IdTimeoutInfinite): Boolean; override; function SelectRead(const ATimeout: Integer = IdTimeoutInfinite): Boolean; override; function SelectReadList(var VSocketList: TIdSocketList; const ATimeout: Integer = IdTimeoutInfinite): Boolean; override; End;//TIdSocketList TIdStackLibc = class(TIdStackBSDBase) private procedure WriteChecksumIPv6(s: TIdStackSocketHandle; var VBuffer: TIdBytes; const AOffset: Integer; const AIP: String; const APort: TIdPort); protected function GetLastError : Integer; procedure SetLastError(Const AError : Integer); function HostByName(const AHostName: string; const AIPVersion: TIdIPVersion = ID_DEFAULT_IP_VERSION): string; override; function ReadHostName: string; override; function WSCloseSocket(ASocket: TIdStackSocketHandle): Integer; override; function WSRecv(ASocket: TIdStackSocketHandle; var ABuffer; const ABufferLength, AFlags: Integer): Integer; override; function WSSend(ASocket: TIdStackSocketHandle; const ABuffer; const ABufferLength, AFlags: Integer): Integer; override; function WSShutdown(ASocket: TIdStackSocketHandle; AHow: Integer): Integer; override; {$IFNDEF VCL_XE3_OR_ABOVE} procedure WSGetSocketOption(ASocket: TIdStackSocketHandle; ALevel: TIdSocketOptionLevel; AOptName: TIdSocketOption; var AOptVal; var AOptLen: Integer); override; procedure WSSetSocketOption(ASocket: TIdStackSocketHandle; ALevel: TIdSocketOptionLevel; AOptName: TIdSocketOption; const AOptVal; const AOptLen: Integer); override; {$ENDIF} public procedure SetBlocking(ASocket: TIdStackSocketHandle; const ABlocking: Boolean); override; function WouldBlock(const AResult: Integer): Boolean; override; function WSTranslateSocketErrorMsg(const AErr: Integer): string; override; function Accept(ASocket: TIdStackSocketHandle; var VIP: string; var VPort: TIdPort; var VIPVersion: TIdIPVersion): TIdStackSocketHandle; override; procedure Bind(ASocket: TIdStackSocketHandle; const AIP: string; const APort: TIdPort; const AIPVersion: TIdIPVersion = ID_DEFAULT_IP_VERSION); override; procedure Connect(const ASocket: TIdStackSocketHandle; const AIP: string; const APort: TIdPort; const AIPVersion: TIdIPVersion = ID_DEFAULT_IP_VERSION); override; function HostByAddress(const AAddress: string; const AIPVersion: TIdIPVersion = ID_DEFAULT_IP_VERSION): string; override; function WSGetLastError: Integer; override; procedure WSSetLastError(const AErr : Integer); override; function WSGetServByName(const AServiceName: string): TIdPort; override; function WSGetServByPort(const APortNumber: TIdPort): TStrings; override; procedure GetPeerName(ASocket: TIdStackSocketHandle; var VIP: string; var VPort: TIdPort; var VIPVersion: TIdIPVersion); override; procedure GetSocketName(ASocket: TIdStackSocketHandle; var VIP: string; var VPort: TIdPort; var VIPVersion: TIdIPVersion); override; procedure Listen(ASocket: TIdStackSocketHandle; ABackLog: Integer); override; function HostToNetwork(AValue: UInt16): UInt16; override; function NetworkToHost(AValue: UInt16): UInt16; override; function HostToNetwork(AValue: UInt32): UInt32; override; function NetworkToHost(AValue: UInt32): UInt32; override; function HostToNetwork(AValue: TIdUInt64): TIdUInt64; override; function NetworkToHost(AValue: TIdUInt64): TIdUInt64; override; function RecvFrom(const ASocket: TIdStackSocketHandle; var VBuffer; const ALength, AFlags: Integer; var VIP: string; var VPort: TIdPort; AIPVersion: TIdIPVersion = ID_DEFAULT_IP_VERSION): Integer; override; function ReceiveMsg(ASocket: TIdStackSocketHandle; var VBuffer: TIdBytes; APkt: TIdPacketInfo): UInt32; override; procedure WSSendTo(ASocket: TIdStackSocketHandle; const ABuffer; const ABufferLength, AFlags: Integer; const AIP: string; const APort: TIdPort; AIPVersion: TIdIPVersion = ID_DEFAULT_IP_VERSION); override; function WSSocket(AFamily : Integer; AStruct : TIdSocketType; AProtocol: Integer; const AOverlapped: Boolean = False): TIdStackSocketHandle; override; procedure Disconnect(ASocket: TIdStackSocketHandle); override; {$IFDEF VCL_XE3_OR_ABOVE} procedure GetSocketOption(ASocket: TIdStackSocketHandle; ALevel: TIdSocketOptionLevel; AOptName: TIdSocketOption; var AOptVal; var AOptLen: Integer); override; procedure SetSocketOption(ASocket: TIdStackSocketHandle; ALevel: TIdSocketOptionLevel; AOptName: TIdSocketOption; const AOptVal; const AOptLen: Integer); override; {$ENDIF} procedure SetKeepAliveValues(ASocket: TIdStackSocketHandle; const AEnabled: Boolean; const ATimeMS, AInterval: Integer); override; function SupportsIPv6: Boolean; overload; override; function CheckIPVersionSupport(const AIPVersion: TIdIPVersion): boolean; override; constructor Create; override; destructor Destroy; override; //In Windows, this writes a checksum into a buffer. In Linux, it would probably //simply have the kernal write the checksum with something like this (RFC 2292): // // int offset = 2; // setsockopt(fd, IPPROTO_IPV6, IPV6_CHECKSUM, &offset, sizeof(offset)); // // Note that this should be called //IMMEDIATELY before you do a SendTo because the Local IPv6 address might change procedure WriteChecksum(s : TIdStackSocketHandle; var VBuffer : TIdBytes; const AOffset : Integer; const AIP : String; const APort : TIdPort; const AIPVersion: TIdIPVersion = ID_DEFAULT_IP_VERSION); override; function IOControl(const s: TIdStackSocketHandle; const cmd: UInt32; var arg: UInt32): Integer; override; procedure GetLocalAddressList(AAddresses: TIdStackLocalAddressList); override; end; TLinger = record l_onoff: UInt16; l_linger: UInt16; end; TIdLinger = TLinger; implementation uses IdResourceStrings, IdException, SysUtils; type psockaddr_in6 = ^sockaddr_in6; const Id_MSG_NOSIGNAL = MSG_NOSIGNAL; Id_WSAEPIPE = EPIPE; constructor TIdStackLibc.Create; begin inherited Create; end; destructor TIdStackLibc.Destroy; begin inherited Destroy; end; function TIdStackLibc.GetLastError : Integer; begin Result := errno; end; procedure TIdStackLibc.SetLastError(Const AError : Integer); begin __errno_location^ := AError; end; procedure TIdStackLibc.WSSetLastError(const AErr : Integer); begin SetLastError(AErr); end; function TIdStackLibc.Accept(ASocket: TIdStackSocketHandle; var VIP: string; var VPort: TIdPort; var VIPVersion: TIdIPVersion): TIdStackSocketHandle; var LN: UInt32; LAddr: sockaddr_in6; begin LN := SizeOf(LAddr); Result := Libc.accept(ASocket, PSockAddr(@LAddr), @LN); if Result <> SOCKET_ERROR then begin case LAddr.sin6_family of Id_PF_INET4: begin with Psockaddr(@LAddr)^ do begin VIP := TranslateTInAddrToString(sin_addr, Id_IPv4); VPort := Ntohs(sin_port); end; VIPVersion := Id_IPV4; end; Id_PF_INET6: begin with LAddr do begin VIP := TranslateTInAddrToString(sin6_addr, Id_IPv6); VPort := ntohs(sin6_port); end; VIPVersion := Id_IPV6; end; else begin Libc.__close(Result); Result := Id_INVALID_SOCKET; IPVersionUnsupported; end; end; end else begin if GetLastError = EBADF then begin SetLastError(EINTR); end; end; end; procedure TIdStackLibc.Bind(ASocket: TIdStackSocketHandle; const AIP: string; const APort: TIdPort; const AIPVersion: TIdIPVersion = ID_DEFAULT_IP_VERSION); var LAddr: sockaddr_in6; begin FillChar(LAddr, SizeOf(LAddr), 0); case AIPVersion of Id_IPv4: begin with Psockaddr(@LAddr)^ do begin sin_family := Id_PF_INET4; if AIP <> '' then begin TranslateStringToTInAddr(AIP, sin_addr, Id_IPv4); end; sin_port := htons(APort); end; CheckForSocketError(Libc.bind(ASocket, {$IFDEF LIBCPASS_STRUCT}PSockAddr(@LAddr)^ {$ELSE} Psockaddr(@LAddr) {$ENDIF},SizeOf(sockaddr))); end; Id_IPv6: begin with LAddr do begin sin6_family := Id_PF_INET6; if AIP <> '' then begin TranslateStringToTInAddr(AIP, sin6_addr, Id_IPv6); end; sin6_port := htons(APort); end; CheckForSocketError(Libc.bind(ASocket, {$IFDEF LIBCPASS_STRUCT}Psockaddr(@LAddr)^ {$ELSE}Psockaddr(@LAddr){$ENDIF}, SizeOf(sockaddr_in6))); end; else begin IPVersionUnsupported; end; end; end; function TIdStackLibc.WSCloseSocket(ASocket: TIdStackSocketHandle): Integer; begin Result := Libc.__close(ASocket); end; procedure TIdStackLibc.Connect(const ASocket: TIdStackSocketHandle; const AIP: string; const APort: TIdPort; const AIPVersion: TIdIPVersion = ID_DEFAULT_IP_VERSION); var LAddr: sockAddr_in6; begin FillChar(LAddr, SizeOf(LAddr), 0); case AIPVersion of Id_IPv4: begin with Psockaddr(@LAddr)^ do begin sin_family := Id_PF_INET4; TranslateStringToTInAddr(AIP, sin_addr, Id_IPv4); sin_port := htons(APort); end; CheckForSocketError(Libc.connect( ASocket, {$IFDEF LIBCPASS_STRUCT}PSockAddr(@LAddr)^{$ELSE}Psockaddr(@LAddr){$ENDIF}, SizeOf(sockaddr))); end; Id_IPv6: begin with LAddr do begin sin6_family := Id_PF_INET6; TranslateStringToTInAddr(AIP, sin6_addr, Id_IPv6); sin6_port := htons(APort); end; CheckForSocketError(Libc.connect( ASocket, {$IFDEF LIBCPASS_STRUCT}Psockaddr(@LAddr)^{$ELSE}Psockaddr(@LAddr){$ENDIF}, SizeOf(sockaddr_in6))); end; else begin IPVersionUnsupported; end; end; end; function TIdStackLibc.HostByName(const AHostName: string; const AIPVersion: TIdIPVersion = ID_DEFAULT_IP_VERSION): string; var Lpa: PAnsiChar; Lsa: TInAddr; LHost: PHostEnt; // ipv6 LHints: TAddressInfo; {$IFDEF LIBCPASS_STRUCT} LAddrInfo: PAddressInfo; {$ELSE} LAddrInfo: PAddrInfo; {$ENDIF} LRetVal: Integer; {$IFDEF STRING_IS_UNICODE} LAStr: AnsiString; {$ENDIF} begin case AIPVersion of Id_IPv4: begin {$IFDEF STRING_IS_UNICODE} LAStr := AnsiString(AHostName); // explicit convert to Ansi {$ENDIF} // TODO: use getaddrinfo() instead for IPv4 as well... LHost := Libc.gethostbyname( PAnsiChar({$IFDEF STRING_IS_UNICODE}LAStr{$ELSE}AHostName{$ENDIF})); if LHost <> nil then begin // TODO: gethostbynaame() might return other things besides IPv4 // addresses, so we should be validating the address type before // attempting the conversion... Lpa := LHost^.h_addr_list^; Lsa.S_un_b.s_b1 := Ord(Lpa[0]); Lsa.S_un_b.s_b2 := Ord(Lpa[1]); Lsa.S_un_b.s_b3 := Ord(Lpa[2]); Lsa.S_un_b.s_b4 := Ord(Lpa[3]); Result := TranslateTInAddrToString(Lsa, Id_IPv4); end else begin //RaiseSocketError(h_errno); RaiseLastSocketError; end; end; Id_IPv6: begin FillChar(LHints, SizeOf(LHints), 0); LHints.ai_family := IdIPFamily[AIPVersion]; LHints.ai_socktype := Integer(SOCK_STREAM); LAddrInfo := nil; {$IFDEF STRING_IS_UNICODE} LAStr := AnsiString(AHostName); // explicit convert to Ansi {$ENDIF} LRetVal := getaddrinfo( PAnsiChar({$IFDEF STRING_IS_UNICODE}LAStr{$ELSE}AHostName{$ENDIF}), nil, @LHints, {$IFDEF LIBCPASS_STRUCT}LAddrInfo{$ELSE}@LAddrInfo{$ENDIF}); if LRetVal <> 0 then begin if LRetVal = EAI_SYSTEM then begin IndyRaiseLastError; end else begin raise EIdResolveError.CreateFmt(RSResolveError, [AHostName, gai_strerror(LRetVal), LRetVal]); end; end; try Result := TranslateTInAddrToString(LAddrInfo^.ai_addr^.sin_zero, Id_IPv6); finally freeaddrinfo(LAddrInfo); end; end else Result := ''; // avoid warning IPVersionUnsupported; end; end; function TIdStackLibc.ReadHostName: string; var LStr: AnsiString; begin SetLength(LStr, 250); Libc.gethostname(PAnsiChar(LStr), 250); Result := String(LStr); end; procedure TIdStackLibc.Listen(ASocket: TIdStackSocketHandle; ABackLog: Integer); begin CheckForSocketError(Libc.listen(ASocket, ABacklog)); end; function TIdStackLibc.WSRecv(ASocket: TIdStackSocketHandle; var ABuffer; const ABufferLength, AFlags: Integer): Integer; begin //IdStackWindows is just: Result := Recv(ASocket, ABuffer, ABufferLength, AFlags); Result := Recv(ASocket, ABuffer, ABufferLength, AFlags or Id_MSG_NOSIGNAL); end; function TIdStackLibc.RecvFrom(const ASocket: TIdStackSocketHandle; var VBuffer; const ALength, AFlags: Integer; var VIP: string; var VPort: TIdPort; AIPVersion: TIdIPVersion = ID_DEFAULT_IP_VERSION ): Integer; var LiSize: UInt32; LAddr: sockaddr_in6; begin case AIPVersion of Id_IPv4, Id_IPv6: begin if AIPVersion = Id_IPv4 then begin LiSize := SizeOf(sockaddr); end else begin LiSize := SizeOf(sockaddr_in6); end; Result := Libc.recvfrom(ASocket, VBuffer, ALength, AFlags or Id_MSG_NOSIGNAL, PSockAddr(@LAddr), @LiSize); if AIPVersion = Id_IPv4 then begin with Psockaddr(@LAddr)^ do begin VIP := TranslateTInAddrToString(sin_addr, Id_IPv4); VPort := ntohs(sin_port); end; end else begin with LAddr do begin VIP := TranslateTInAddrToString(sin6_addr, Id_IPv6); VPort := ntohs(sin6_port); end; end; end; else begin Result := 0; IPVersionUnsupported; end; end; end; function TIdStackLibc.ReceiveMsg(ASocket: TIdStackSocketHandle; var VBuffer: TIdBytes; APkt: TIdPacketInfo): UInt32; {var LIP : String; LPort : TIdPort; LSize: UInt32; LAddr: SockAddr_In6; LMsg : msghdr; LMsgBuf : BUF; LControl : TIdBytes; LCurCmsg : CMSGHDR; //for iterating through the control buffer LCurPt : Pin_pktinfo; LCurPt6 : Pin6_pktinfo; LByte : PByte; LDummy, LDummy2 : UInt32; begin //we call the macro twice because we specified two possible structures. //Id_IPV6_HOPLIMIT and Id_IPV6_PKTINFO LSize := CMSG_LEN(CMSG_LEN(Length(VBuffer))); SetLength( LControl,LSize); LMsgBuf.len := Length(VBuffer); // Length(VMsgData); LMsgBuf.buf := @VBuffer[0]; // @VMsgData[0]; FillChar(LMsg,SizeOf(LMsg),0); LMsg.lpBuffers := @LMsgBuf; LMsg.dwBufferCount := 1; LMsg.Control.Len := LSize; LMsg.Control.buf := @LControl[0]; LMsg.name := PSOCKADDR(@LAddr); LMsg.namelen := SizeOf(LAddr); CheckForSocketError(RecvMsg(ASocket, @LMsg, Result, @LDummy, LPwsaoverlapped_COMPLETION_ROUTINE(@LDummy2))); APkt.Reset; case LAddr.sin6_family of Id_PF_INET4: begin with PSOCKADDR(@LAddr)^ do begin APkt.SourceIP := TranslateTInAddrToString(sin_addr, Id_IPv4); APkt.SourcePort := NToHs(sin_port); end; APkt.SourceIPVersion := Id_IPv4; end; Id_PF_INET6: begin with LAddr do begin APkt.SourceIP := TranslateTInAddrToString(sin6_addr, Id_IPv6); APkt.SourcePort := NToHs(sin6_port); end; APkt.SourceIPVersion := Id_IPv6; end; else begin Result := 0; // avoid warning IPVersionUnsupported; end; end; LCurCmsg := nil; repeat LCurCmsg := CMSG_NXTHDR(@LMsg,LCurCmsg); if LCurCmsg=nil then begin break; end; case LCurCmsg^.cmsg_type of IP_PKTINFO : //done this way because IPV6_PKTINF and IP_PKTINFO //are both 19 begin case LAddr.sin6_family of Id_PF_INET4: begin LCurPt := WSA_CMSG_DATA(LCurCmsg); APkt.DestIP := GWindowsStack.TranslateTInAddrToString(LCurPt^.ipi_addr,Id_IPv4); APkt.DestIF := LCurPt^.ipi_ifindex; APkt.DestIPVersion := Id_IPv4; end; Id_PF_INET6: begin LCurPt6 := WSA_CMSG_DATA(LCurCmsg); APkt.DestIP := GWindowsStack.TranslateTInAddrToString(LCurPt6^.ipi6_addr,Id_IPv6); APkt.DestIF := LCurPt6^.ipi6_ifindex; APkt.DestIPVersion := Id_IPv6; end; end; end; Id_IPV6_HOPLIMIT : begin LByte := PByte(WSA_CMSG_DATA(LCurCmsg)); APkt.TTL := LByte^; end; end; until False; } begin APkt.Reset; Result := 0; // avoid warning end; function TIdStackLibc.WSSend(ASocket: TIdStackSocketHandle; const ABuffer; const ABufferLength, AFlags: Integer): Integer; begin //CC: Should Id_MSG_NOSIGNAL be included? // Result := Send(ASocket, ABuffer, ABufferLength, AFlags or Id_MSG_NOSIGNAL); Result := CheckForSocketError(Libc.send(ASocket, ABuffer, ABufferLength, AFlags)); end; procedure TIdStackLibc.WSSendTo(ASocket: TIdStackSocketHandle; const ABuffer; const ABufferLength, AFlags: Integer; const AIP: string; const APort: TIdPort; AIPVersion: TIdIPVersion = ID_DEFAULT_IP_VERSION); var LAddr: sockaddr_in6; LiSize, LBytesOut: Integer; begin case AIPVersion of Id_IPv4, Id_IPv6: begin FillChar(LAddr, SizeOf(LAddr), 0); if AIPVersion = Id_IPv4 then begin with PsockAddr(@LAddr)^ do begin sin_family := Id_PF_INET4; TranslateStringToTInAddr(AIP, sin_addr, Id_IPV4); sin_port := htons(APort); end; LiSize := SizeOf(sockaddr); end else begin with LAddr do begin sin6_family := Id_PF_INET6; TranslateStringToTInAddr(AIP, sin6_addr, AIPVersion); sin6_port := htons(APort); end; LiSize := SizeOf(sockaddr_in6); end; LBytesOut := Libc.sendto( ASocket, ABuffer, ABufferLength, AFlags or Id_MSG_NOSIGNAL, {$IFDEF LIBCPASS_STRUCT}Psockaddr(@LAddr)^{$ELSE}Psockaddr(@LAddr){$ENDIF}, LiSize); end; else begin LBytesOut := 0; // avoid warning IPVersionUnsupported; end; end; if LBytesOut = Id_SOCKET_ERROR then begin // TODO: move this into RaiseLastSocketError directly if WSGetLastError() = Id_WSAEMSGSIZE then begin raise EIdPackageSizeTooBig.Create(RSPackageSizeTooBig); end else begin RaiseLastSocketError; end; end else if LBytesOut <> ABufferLength then begin raise EIdNotAllBytesSent.Create(RSNotAllBytesSent); end; end; procedure TIdStackLibc.{$IFDEF VCL_XE3_OR_ABOVE}GetSocketOption{$ELSE}WSGetSocketOption{$ENDIF} (ASocket: TIdStackSocketHandle; ALevel: TIdSocketOptionLevel; AOptName: TIdSocketOption; var AOptVal; var AOptLen: Integer); var LLen: UInt32; begin LLen := AOptLen; CheckForSocketError(Libc.getsockopt(ASocket, ALevel, AOptName, PIdAnsiChar(@AOptVal), LLen)); AOptLen := LLen; end; procedure TIdStackLibc.{$IFDEF VCL_XE3_OR_ABOVE}SetSocketOption{$ELSE}WSSetSocketOption{$ENDIF} (ASocket: TIdStackSocketHandle; ALevel: TIdSocketOptionLevel; AOptName: TIdSocketOption; const AOptVal; const AOptLen: Integer); begin CheckForSocketError(Libc.setsockopt(ASocket, ALevel, AOptName, PIdAnsiChar(@AOptVal), AOptLen)); end; function TIdStackLibc.WSGetLastError: Integer; begin //IdStackWindows just uses result := WSAGetLastError; Result := GetLastError; //System.GetLastOSError; - FPC doesn't define it in System if Result = Id_WSAEPIPE then begin Result := Id_WSAECONNRESET; end; end; function TIdStackLibc.WSSocket(AFamily : Integer; AStruct : TIdSocketType; AProtocol: Integer; const AOverlapped: Boolean = False): TIdStackSocketHandle; override; begin Result := Libc.socket(AFamily, AStruct, AProtocol); end; function TIdStackLibc.WSGetServByName(const AServiceName: string): TIdPort; var Lps: PServEnt; {$IFDEF STRING_IS_UNICODE} LAStr: AnsiString; {$ENDIF} begin {$IFDEF STRING_IS_UNICODE} LAStr := AnsiString(AServiceName); // explicit convert to Ansi {$ENDIF} Lps := Libc.getservbyname( PAnsiChar({$IFDEF STRING_IS_UNICODE}LAStr{$ELSE}AServiceName{$ENDIF}), nil); if Lps <> nil then begin Result := ntohs(Lps^.s_port); end else begin try Result := IndyStrToInt(AServiceName); except on EConvertError do begin IndyRaiseOuterException(EIdInvalidServiceName.CreateFmt(RSInvalidServiceName, [AServiceName])); end; end; end; end; function TIdStackLibc.WSGetServByPort(const APortNumber: TIdPort): TStrings; type PPAnsiCharArray = ^TPAnsiCharArray; TPAnsiCharArray = packed array[0..(Maxint div SizeOf(PAnsiChar))-1] of PAnsiChar; var Lps: PServEnt; Li: Integer; Lp: PPAnsiCharArray; begin Result := TStringList.Create; try Lps := Libc.getservbyport(htons(APortNumber), nil); if Lps <> nil then begin Result.Add(String(Lps^.s_name)); Li := 0; Lp := Pointer(Lps^.s_aliases); while Lp[Li] <> nil do begin Result.Add(String(Lp[Li])); Inc(Li); end; end; except FreeAndNil(Result); raise; end; end; function TIdStackLibc.HostToNetwork(AValue: UInt16): UInt16; begin Result := htons(AValue); end; function TIdStackLibc.NetworkToHost(AValue: UInt16): UInt16; begin Result := ntohs(AValue); end; function TIdStackLibc.HostToNetwork(AValue: UInt32): UInt32; begin Result := htonl(AValue); end; function TIdStackLibc.NetworkToHost(AValue: UInt32): UInt32; begin Result := ntohl(AValue); end; { RP - I'm not sure what endian Linux natively uses, thus the check to see if the bytes need swapping or not ... } function TIdStackLibc.HostToNetwork(AValue: TIdUInt64): TIdUInt64; var LParts: TIdUInt64Parts; L: UInt32; begin LParts.QuadPart := AValue{$IFDEF TIdUInt64_IS_NOT_NATIVE}.QuadPart{$ENDIF}; L := htonl(LParts.HighPart); if (L <> LParts.HighPart) then begin LParts.HighPart := htonl(LParts.LowPart); LParts.LowPart := L; end; Result{$IFDEF TIdUInt64_IS_NOT_NATIVE}.QuadPart{$ENDIF} := LParts.QuadPart; end; function TIdStackLibc.NetworkToHost(AValue: TIdUInt64): TIdUInt64; var LParts: TIdUInt64Parts; L: UInt32; begin LParts.QuadPart := AValue{$IFDEF TIdUInt64_IS_NOT_NATIVE}.QuadPart{$ENDIF}; L := ntohl(LParts.HighPart); if (L <> LParts.HighPart) then begin LParts.HighPart := ntohl(LParts.LowPart); LParts.LowPart := L; end; Result{$IFDEF TIdUInt64_IS_NOT_NATIVE}.QuadPart{$ENDIF} := LParts.QuadPart; end; procedure TIdStackLibc.GetLocalAddressList(AAddresses: TIdStackLocalAddressList); {$IFNDEF HAS_getifaddrs} type TaPInAddr = array[0..250] of PInAddr; PaPInAddr = ^TaPInAddr; TaPIn6Addr = array[0..250] of PIn6Addr; PaPIn6Addr = ^TaPIn6Addr; {$ENDIF} var {$IFDEF HAS_getifaddrs} LAddrList, LAddrInfo: pifaddrs; LSubNetStr: string; {$ELSE} Li: Integer; LAHost: PHostEnt; LPAdrPtr: PaPInAddr; LPAdr6Ptr: PaPIn6Addr; LHostName: AnsiString; {$ENDIF} begin // TODO: Using gethostname() and gethostbyname() like this may not always // return just the machine's IP addresses. Technically speaking, they will // return the local hostname, and then return the address(es) to which that // hostname resolves. It is possible for a machine to (a) be configured such // that its name does not resolve to an IP, or (b) be configured such that // its name resolves to multiple IPs, only one of which belongs to the local // machine. For better results, we should use getifaddrs() on platforms that // support it... {$IFDEF HAS_getifaddrs} if getifaddrs(@LAddrList) = 0 then // TODO: raise an exception if it fails try AAddresses.BeginUpdate; try LAddrInfo := LAddrList; repeat if (LAddrInfo^.ifa_addr <> nil) and ((LAddrInfo^.ifa_flags and IFF_LOOPBACK) = 0) then begin case LAddrInfo^.ifa_addr^.sa_family of Id_PF_INET4: begin if LAddrInfo^.ifa_netmask <> nil then begin LSubNetStr := TranslateTInAddrToString(PSockAddr_In(LAddrInfo^.ifa_netmask)^.sin_addr, Id_IPv4); end else begin LSubNetStr := ''; end; TIdStackLocalAddressIPv4.Create(AAddresses, TranslateTInAddrToString(PSockAddr_In(LAddrInfo^.ifa_addr)^.sin_addr, Id_IPv4), LSubNetStr); end; Id_PF_INET6: begin TIdStackLocalAddressIPv6.Create(AAddresses, TranslateTInAddrToString(PSockAddr_In6(LAddrInfo^.ifa_addr)^.sin6_addr, Id_IPv6)); end; end; end; LAddrInfo := LAddrInfo^.ifa_next; until LAddrInfo = nil; finally AAddresses.EndUpdate; end; finally freeifaddrs(LAddrList); end; {$ELSE} // this won't get IPv6 addresses as I didn't find a way // to enumerate IPv6 addresses on a linux machine LHostName := AnsiString(HostName); LAHost := Libc.gethostbyname(PAnsiChar(LHostName)); if LAHost = nil then begin RaiseLastSocketError; end; // gethostbyname() might return other things besides IPv4 addresses, so we // need to validate the address type before attempting the conversion... case LAHost^.h_addrtype of Id_PF_INET4: begin LPAdrPtr := PAPInAddr(LAHost^.h_addr_list); Li := 0; if LPAdrPtr^[Li] <> nil then begin AAddresses.BeginUpdate; try repeat TIdStackLocalAddressIPv4.Create(Addresses, TranslateTInAddrToString(LPAdrPtr^[Li]^, Id_IPv4), ''); // TODO: SubNet Inc(Li); until LPAdrPtr^[Li] = nil; finally AAddresses.EndUpdate; end; end; end; Id_PF_INET6: begin LPAdr6Ptr := PAPIn6Addr(LAHost^.h_addr_list); Li := 0; if LPAdr6Ptr^[Li] <> nil then begin AAddresses.BeginUpdate; try repeat TIdStackLocalAddressIPv6.Create(Addresses, TranslateTInAddrToString(LPAdr6Ptr^[Li]^, Id_IPv6)); Inc(Li); until LPAdr6Ptr^[Li] = nil; finally AAddresses.EndUpdate; end; end; end; end; {$ENDIF} end; function TIdStackLibc.HostByAddress(const AAddress: string; const AIPVersion: TIdIPVersion = ID_DEFAULT_IP_VERSION): string; var LAddr: sockaddr_in6; LSize: UInt32; LHostName : array[0..NI_MAXHOST] of TIdAnsiChar; {$IFDEF USE_MARSHALLED_PTRS} LHostNamePtr: TPtrWrapper; {$ENDIF} LRet : Integer; {$IFDEF LIBCPASS_STRUCT} LHints: TAddressInfo; LAddrInfo: PAddressInfo; {$ELSE} LHints: AddrInfo; //The T is no omission - that's what I found in the header LAddrInfo: PAddrInfo; {$ENDIF} begin FillChar(LAddr, SizeOf(LAddr), 0); case AIPVersion of Id_IPv4: begin with Psockaddr(@LAddr)^ do begin sin_family := Id_PF_INET4; TranslateStringToTInAddr(AAddress, sin_addr, Id_IPv4); end; LSize := SizeOf(sockaddr); end; Id_IPv6: begin with LAddr do begin sin6_family := Id_PF_INET6; TranslateStringToTInAddr(AAddress, sin6_addr, Id_IPv6); end; LSize := SizeOf(sockaddr_in6); end; else begin LSize := 0; // avoid warning IPVersionUnsupported; end; end; FillChar(LHostName[0],Length(LHostName),0); {$IFDEF USE_MARSHALLED_PTRS} LHostNamePtr := TPtrWrapper.Create(@LHostName[0]); {$ENDIF} LRet := getnameinfo( {$IFDEF LIBCPASS_STRUCT}Psockaddr(@LAddr)^{$ELSE}Psockaddr(@LAddr){$ENDIF}, LSize, {$IFDEF USE_MARSHALLED_PTRS} LHostNamePtr.ToPointer {$ELSE} LHostName {$ENDIF}, NI_MAXHOST,nil,0,NI_NAMEREQD ); if LRet <> 0 then begin if LRet = EAI_SYSTEM then begin RaiseLastOSError; end else begin raise EIdReverseResolveError.CreateFmt(RSReverseResolveError, [AAddress, gai_strerror(LRet), LRet]); end; end; { IMPORTANT!!! getnameinfo can return either results from a numeric to text conversion or results from a DNS reverse lookup. Someone could make a malicous PTR record such as 1.0.0.127.in-addr.arpa. IN PTR 10.1.1.1 and trick a caller into beleiving the socket address is 10.1.1.1 instead of 127.0.0.1. If there is a numeric host in LAddr, than this is the case and we disregard the result and raise an exception. } FillChar(LHints,SizeOf(LHints),0); LHints.ai_socktype := SOCK_DGRAM; //*dummy*/ LHints.ai_flags := AI_NUMERICHOST; if getaddrinfo( {$IFDEF USE_MARSHALLED_PTRS} LHostNamePtr.ToPointer {$ELSE} LHostName {$ENDIF}, '0', LHints, LAddrInfo) = 0 then begin freeaddrinfo(LAddrInfo^); Result := ''; raise EIdMaliciousPtrRecord.Create(RSMaliciousPtrRecord); end; {$IFDEF USE_MARSHALLED_PTRS} Result := TMarshal.ReadStringAsAnsi(LHostNamePtr); {$ELSE} Result := String(LHostName); {$ENDIF} (* JMB: I left this in here just in case someone complains, but the other code works on all linux systems for all addresses and is thread-safe variables for it: Host: PHostEnt; LAddr: u_long; Id_IPv4: begin // GetHostByAddr is thread-safe in Linux. // It might not be safe in Solaris or BSD Unix LAddr := inet_addr(PAnsiChar(AAddress)); Host := GetHostByAddr(@LAddr,SizeOf(LAddr),AF_INET); if (Host <> nil) then begin Result := Host^.h_name; end else begin RaiseSocketError(h_errno); end; end; *) end; function TIdStackLibc.WSShutdown(ASocket: TIdStackSocketHandle; AHow: Integer): Integer; begin Result := Libc.shutdown(ASocket, AHow); end; procedure TIdStackLibc.Disconnect(ASocket: TIdStackSocketHandle); begin // Windows uses Id_SD_Send, Linux should use Id_SD_Both WSShutdown(ASocket, Id_SD_Both); // SO_LINGER is false - socket may take a little while to actually close after this WSCloseSocket(ASocket); end; procedure TIdStackLibc.GetPeerName(ASocket: TIdStackSocketHandle; var VIP: string; var VPort: TIdPort; var VIPVersion: TIdIPVersion); var i: UInt32; LAddr: sockaddr_in6; begin i := SizeOf(LAddr); CheckForSocketError(Libc.getpeername(ASocket, Psockaddr(@LAddr)^, i)); case LAddr.sin6_family of Id_PF_INET4: begin with Psockaddr(@LAddr)^ do begin VIP := TranslateTInAddrToString(sin_addr, Id_IPv4); VPort := ntohs(sin_port); end; VIPVersion := Id_IPV4; end; Id_PF_INET6: begin with LAddr do begin VIP := TranslateTInAddrToString(sin6_addr, Id_IPv6); VPort := Ntohs(sin6_port); end; VIPVersion := Id_IPV6; end; else begin IPVersionUnsupported; end; end; end; procedure TIdStackLibc.GetSocketName(ASocket: TIdStackSocketHandle; var VIP: string; var VPort: TIdPort; var VIPVersion: TIdIPVersion); var i: UInt32; LAddr: sockaddr_in6; begin i := SizeOf(LAddr); CheckForSocketError(Libc.getsockname(ASocket, Psockaddr(@LAddr)^, i)); case LAddr.sin6_family of Id_PF_INET4: begin with Psockaddr(@LAddr)^ do begin VIP := TranslateTInAddrToString(sin_addr, Id_IPv4); VPort := ntohs(sin_port); end; VIPVersion := Id_IPV4; end; Id_PF_INET6: begin with LAddr do begin VIP := TranslateTInAddrToString(sin6_addr, Id_IPv6); VPort := ntohs(sin6_port); end; VIPVersion := Id_IPV6; end; else begin IPVersionUnsupported; end; end; end; function TIdStackLibc.WouldBlock(const AResult: Integer): Boolean; begin //non-blocking does not exist in Linux, always indicate things will block Result := True; end; function TIdStackLibc.SupportsIPv6: Boolean; begin //In Windows, this does something else. It checks the LSP's installed. Result := CheckIPVersionSupport(Id_IPv6); end; function TIdStackLibc.CheckIPVersionSupport(const AIPVersion: TIdIPVersion): Boolean; var LTmpSocket: TIdStackSocketHandle; begin // TODO: on nix systems (or maybe just Linux?), an alternative would be to // check for the existance of the '/proc/net/if_inet6' kernel pseudo-file LTmpSocket := WSSocket(IdIPFamily[AIPVersion], Integer(Id_SOCK_STREAM), Id_IPPROTO_IP ); Result := LTmpSocket <> Id_INVALID_SOCKET; if Result then begin WSCloseSocket(LTmpSocket); end; end; procedure TIdStackLibc.WriteChecksum(s: TIdStackSocketHandle; var VBuffer: TIdBytes; const AOffset: Integer; const AIP: String; const APort: TIdPort; const AIPVersion: TIdIPVersion); begin case AIPVersion of Id_IPv4 : CopyTIdUInt16(HostToLittleEndian(CalcCheckSum(VBuffer)), VBuffer, AOffset); Id_IPv6 : WriteChecksumIPv6(s, VBuffer, AOffset, AIP, APort); else IPVersionUnsupported; end; end; procedure TIdStackLibc.WriteChecksumIPv6(s: TIdStackSocketHandle; var VBuffer: TIdBytes; const AOffset: Integer; const AIP: String; const APort: TIdPort); begin //we simply request that the kernal write the checksum when the data //is sent. All of the parameters required are because Windows is bonked //because it doesn't have the IPV6CHECKSUM socket option meaning we have //to querry the network interface in TIdStackWindows -- yuck!! SetSocketOption(s, IPPROTO_IPV6, IPV6_CHECKSUM, AOffset); end; function TIdStackLibc.IOControl(const s: TIdStackSocketHandle; const cmd: UInt32; var arg: UInt32): Integer; begin Result := ioctl(s, cmd, @arg); end; procedure TIdStackLibc.SetKeepAliveValues(ASocket: TIdStackSocketHandle; const AEnabled: Boolean; const ATimeMS, AInterval: Integer); begin if AEnabled then begin SetSocketOption(ASocket, Id_SOL_TCP, Id_TCP_KEEPIDLE, ATimeMS div MSecsPerSec); SetSocketOption(ASocket, Id_SOL_TCP, Id_TCP_KEEPINTVL, AInterval div MSecsPerSec); end; inherited; end; { TIdSocketListLibc } procedure TIdSocketListLibc.Add(AHandle: TIdStackSocketHandle); begin Lock; try if not FD_ISSET(AHandle, FFDSet) then begin if Count >= __FD_SETSIZE then begin raise EIdStackSetSizeExceeded.Create(RSSetSizeExceeded); end; FD_SET(AHandle, FFDSet); Inc(FCount); end; finally Unlock; end; end;// procedure TIdSocketListLibc.Clear; begin Lock; try FD_ZERO(FFDSet); FCount := 0; finally Unlock; end; end; function TIdSocketListLibc.ContainsSocket( AHandle: TIdStackSocketHandle): boolean; begin Lock; try Result := FD_ISSET(AHandle, FFDSet); finally Unlock; end; end; function TIdSocketListLibc.Count: Integer; begin Lock; try Result := FCount; finally Unlock; end; end;// class function TIdSocketListLibc.FDSelect(AReadSet, AWriteSet, AExceptSet: PFDSet; const ATimeout: Integer): integer; var LTime: TTimeVal; LTimePtr: PTimeVal; begin if ATimeout = IdTimeoutInfinite then begin LTimePtr := nil; end else begin LTime.tv_sec := ATimeout div 1000; LTime.tv_usec := (ATimeout mod 1000) * 1000; LTimePtr := @LTime; end; Result := Libc.select(FD_SETSIZE, AReadSet, AWriteSet, AExceptSet, LTimePtr); end; procedure TIdSocketListLibc.GetFDSet(var VSet: TFDSet); begin Lock; try VSet := FFDSet; finally Unlock; end; end; function TIdSocketListLibc.GetItem(AIndex: Integer): TIdStackSocketHandle; var LIndex, i: Integer; begin Result := 0; Lock; try LIndex := 0; //? use FMaxHandle div x for i:= 0 to __FD_SETSIZE - 1 do begin if FD_ISSET(i, FFDSet) then begin if LIndex = AIndex then begin Result := i; Break; end; Inc(LIndex); end; end; finally Unlock; end; end;// procedure TIdSocketListLibc.Remove(AHandle: TIdStackSocketHandle); begin Lock; try if FD_ISSET(AHandle, FFDSet) then begin Dec(FCount); FD_CLR(AHandle, FFDSet); end; finally Unlock; end; end;// function TIdStackLibc.WSTranslateSocketErrorMsg(const AErr: Integer): string; begin //we override this function for the herr constants that //are returned by the DNS functions case AErr of Libc.HOST_NOT_FOUND: Result := RSStackHOST_NOT_FOUND; Libc.TRY_AGAIN: Result := RSStackTRY_AGAIN; Libc.NO_RECOVERY: Result := RSStackNO_RECOVERY; Libc.NO_DATA: Result := RSStackNO_DATA; else Result := inherited WSTranslateSocketErrorMsg(AErr); end; end; procedure TIdSocketListLibc.SetFDSet(var VSet: TFDSet); begin Lock; try FFDSet := VSet; finally Unlock; end; end; class function TIdSocketListLibc.Select(AReadList: TIdSocketList; AWriteList: TIdSocketList; AExceptList: TIdSocketList; const ATimeout: Integer = IdTimeoutInfinite): Boolean; var LReadSet: TFDSet; LWriteSet: TFDSet; LExceptSet: TFDSet; LPReadSet: PFDSet; LPWriteSet: PFDSet; LPExceptSet: PFDSet; procedure ReadSet(AList: TIdSocketList; var ASet: TFDSet; var APSet: PFDSet); begin if AList <> nil then begin TIdSocketListLibc(AList).GetFDSet(ASet); APSet := @ASet; end else begin APSet := nil; end; end; begin ReadSet(AReadList, LReadSet, LPReadSet); ReadSet(AWriteList, LWriteSet, LPWriteSet); ReadSet(AExceptList, LExceptSet, LPExceptSet); // Result := FDSelect(LPReadSet, LPWriteSet, LPExceptSet, ATimeout) >0; // if AReadList <> nil then begin TIdSocketListLibc(AReadList).SetFDSet(LReadSet); end; if AWriteList <> nil then begin TIdSocketListLibc(AWriteList).SetFDSet(LWriteSet); end; if AExceptList <> nil then begin TIdSocketListLibc(AExceptList).SetFDSet(LExceptSet); end; end; function TIdSocketListLibc.SelectRead(const ATimeout: Integer): Boolean; var LSet: TFDSet; begin Lock; try LSet := FFDSet; // select() updates this structure on return, // so we need to copy it each time we need it finally Unlock; end; Result := FDSelect(@LSet, nil, nil, ATimeout) > 0; end; function TIdSocketListLibc.SelectReadList(var VSocketList: TIdSocketList; const ATimeout: Integer = IdTimeoutInfinite): Boolean; var LSet: TFDSet; begin Lock; try LSet := FFDSet; // select() updates this structure on return, // so we need to copy it each time we need it finally Unlock; end; Result := FDSelect(@LSet, nil, nil, ATimeout) > 0; if Result then begin if VSocketList = nil then begin VSocketList := TIdSocketList.CreateSocketList; end; TIdSocketListLibc(VSocketList).SetFDSet(LSet); end; end; procedure TIdStackLibc.SetBlocking(ASocket: TIdStackSocketHandle; const ABlocking: Boolean); begin if not ABlocking then begin raise EIdBlockingNotSupported.Create(RSStackNotSupportedOnUnix); end; end; (* Why did I remove this again? 1) it sends SIGPIPE even if the socket is created with the no-sigpipe bit set that could be solved by blocking sigpipe within this thread This is probably a bug in the Linux kernel, but we could work around it by blocking that signal for the time of sending the file (just get the sigprocmask, see if pipe bit is set, if not set it and remove again after sending the file) But the more serious reason is another one, which exists in Windows too: 2) I think that ServeFile is misdesigned: ServeFile does not raise an exception if it didn't send all the bytes. Now what happens if I have OnExecute assigned like this AThread.Connection.ServeFile('...', True); // <-- true to send via kernel is that it will return 0, but notice that in this case I didn't ask for the result. Net effect is that the thread will loop in OnExecute even if the socket is long gone. This doesn't fit Indy semantics at all, exceptions are always raised if the remote end disconnects. Even if I would do AThread.Connection.ServeFile('...', False); then it would raise an exception. I think this is a big flaw in the design of the ServeFile function. Maybe GServeFile should only return the bytes sent, but then TCPConnection.ServeFile() should raise an exception if GServeFile didn't send all the bytes. JM Berg, 2002-09-09 function ServeFile(ASocket: TIdStackSocketHandle; AFileName: string): UInt32; var LFileHandle: integer; offset: integer; stat: _stat; begin LFileHandle := open(PAnsiChar(AFileName), O_RDONLY); try offset := 0; fstat(LFileHandle, stat); Result := sendfile(ASocket, LFileHandle, offset, stat.st_size); //** if Result = UInt32(-1) then RaiseLastOSError; finally libc.__close(LFileHandle); end; end; *) function TIdSocketListLibc.Clone: TIdSocketList; begin Result := TIdSocketListLibc.Create; try Lock; try TIdSocketListLibc(Result).SetFDSet(FFDSet); finally Unlock; end; except FreeAndNil(Result); raise; end; end; initialization GSocketListClass := TIdSocketListLibc; end.