idstacklinux.pas

photo.163.com 相册下载器 多线程下载

{ $HDR$}
{**********************************************************************}
{ Unit archived using Team Coherence                                   }
{ Team Coherence is Copyright 2002 by Quality Software Components      }
{                                                                      }
{ For further information / comments, visit our WEB site at            }
{ http://www.TeamCoherence.com                                         }
{**********************************************************************}
{}
{ $Log:  56396: IdStackLinux.pas 
{
{   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 IdStackLinux;

interface

uses
  Classes,
  Libc,
  IdStack,
  IdStackConsts,
  IdTStrings,
  IdGlobal,
  IdIPAddress,
  IdStackBSDBase;

type

  TIdSocketListLinux = 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 Contains(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

  TIdStackLinux = class(TIdStackBSDBase)
  protected
    function HostByName(const AHostName: string;
      const AIPVersion: TIdIPVersion = ID_DEFAULT_IP_VERSION): string; override;
    procedure PopulateLocalAddresses; override;
    function ReadHostName: string; override;
    function WSCloseSocket(ASocket: TIdStackSocketHandle): Integer; override;
    function GetLocalAddress: string; override;
    function GetLocalAddresses: TIdStrings; 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;
  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: Integer; const AIPVersion: TIdIPVersion = ID_DEFAULT_IP_VERSION): TIdStackSocketHandle; override;
    procedure Bind(ASocket: TIdStackSocketHandle; const AIP: string;
     const APort: Integer; 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;
    function WSGetServByName(const AServiceName: string): Integer; override;
    function WSGetServByPort(const APortNumber: Integer): TIdStrings; override;
    procedure WSGetSockOpt(ASocket: TIdStackSocketHandle;
      Alevel, AOptname: Integer; AOptval: PChar; var AOptlen: Integer); override;
    procedure GetSocketOption(ASocket: TIdStackSocketHandle;
      ALevel: TIdSocketOptionLevel; AOptName: TIdSocketOption;
      out AOptVal: Integer); override;
    procedure GetPeerName(ASocket: TIdStackSocketHandle; var VIP: string;
     var VPort: Integer); override;
    procedure GetSocketName(ASocket: TIdStackSocketHandle; var VIP: string;
     var VPort: TIdPort); override;
    procedure Listen(ASocket: TIdStackSocketHandle; ABackLog: Integer); override;
    function HostToNetwork(AValue: Word): Word; override;
    function NetworkToHost(AValue: Word): Word; override;
    function HostToNetwork(AValue: LongWord): LongWord; override;
    function NetworkToHost(AValue: LongWord): LongWord; override;
    function HostToNetwork(AValue: Int64): Int64; override;
    function NetworkToHost(AValue: Int64): Int64; override;
    function RecvFrom(const ASocket: TIdStackSocketHandle; var VBuffer;
     const ALength, AFlags: Integer; var VIP: string; var VPort: Integer;
     AIPVersion: TIdIPVersion = ID_DEFAULT_IP_VERSION): Integer; override;
    procedure WSSendTo(ASocket: TIdStackSocketHandle; const ABuffer;
      const ABufferLength, AFlags: Integer;
      const AIP: string; const APort: Integer; AIPVersion: TIdIPVersion = ID_DEFAULT_IP_VERSION); override;
    function WSSocket(AFamily, AStruct, AProtocol: Integer;
     const AOverlapped: Boolean = False): TIdStackSocketHandle; override;
    procedure Disconnect(ASocket: TIdStackSocketHandle); override;
    procedure SetSocketOption(ASocket: TIdStackSocketHandle; ALevel:TIdSocketOptionLevel;
      AOptName: TIdSocketOption; AOptVal: Integer); overload;override;
    procedure SetSocketOption( const ASocket: TIdStackSocketHandle;
      const Alevel, Aoptname: Integer; Aoptval: PChar; const Aoptlen: Integer ); overload; override;
    function SupportsIPv6: boolean; override;
    constructor Create; override;
    destructor Destroy; override;
  end;

  TLinger = record
    l_onoff: Word;
    l_linger: Word;
  end;
  TIdLinger = TLinger;

implementation
uses
  IdResourceStrings,
  IdResourceStringsCore,  //Needed for RSResolveError
  IdException,
  IdExceptionCore, //Needed for EIdBlockingNotSupported
  SysUtils;

type
  psockaddr_in6 = ^sockaddr_in6;
const
  Id_MSG_NOSIGNAL = MSG_NOSIGNAL;
  Id_WSAEPIPE = EPIPE;

constructor TIdStackLinux.Create;
begin
  inherited Create;
end;

destructor TIdStackLinux.Destroy;
begin
  inherited Destroy;
end;

function TIdStackLinux.Accept(ASocket: TIdStackSocketHandle;
 var VIP: string; var VPort: Integer; const AIPVersion: TIdIPVersion = ID_DEFAULT_IP_VERSION): TIdStackSocketHandle;
var
  LN: Cardinal;
  LAddr: sockaddr_in6;
begin
  LN := SizeOf(LAddr);
  Result := Libc.accept(ASocket, PSockAddr(@LAddr), @LN);
  if Result <> SOCKET_ERROR then begin
    VIP := TranslateTInAddrToString(TIdIn6Addr(LAddr.sin6_addr), AIPVersion);
    VPort := NToHs(LAddr.sin6_port);
  end else begin
    if GetLastError = EBADF then begin
      SetLastError(EINTR);
    end;
  end;
end;

procedure TIdStackLinux.Bind(ASocket: TIdStackSocketHandle;
  const AIP: string; const APort: Integer;
  const AIPVersion: TIdIPVersion = ID_DEFAULT_IP_VERSION);
var
  LAddr: SockAddr;
  LAddr6: SockAddr_in6;
begin
  case AIPVersion of
    Id_IPv4: begin
        LAddr.sin_family := Id_PF_INET4;
        if Length(AIP) = 0 then begin
          LAddr.sin_addr.s_addr := INADDR_ANY;
        end else begin
          TranslateStringToTInAddr(AIP, LAddr.sin_addr, Id_IPv4);
        end;
        LAddr.sin_port := HToNs(APort);
        CheckForSocketError(Libc.Bind(ASocket, LAddr, SizeOf(LAddr)));
      end;
    Id_IPv6: begin
        FillChar(LAddr6, SizeOf(LAddr6), 0);
        LAddr6.sin6_family := Id_PF_INET6;
        if Length(AIP) <> 0 then begin
          TranslateStringToTInAddr(AIP, LAddr6.sin6_addr, Id_IPv6);
        end;
        LAddr6.sin6_port := HToNs(APort);
        CheckForSocketError(Libc.Bind(ASocket, Psockaddr(@LAddr6)^, SizeOf(LAddr6)));
      end;
    else begin
      IPVersionUnsupported;
    end;
  end;
end;

function TIdStackLinux.WSCloseSocket(ASocket: TIdStackSocketHandle): Integer;
begin
  Result := Libc.__close(ASocket);
end;

procedure TIdStackLinux.Connect(const ASocket: TIdStackSocketHandle;
 const AIP: string; const APort: TIdPort;
 const AIPVersion: TIdIPVersion = ID_DEFAULT_IP_VERSION);
var
  LAddr: SockAddr;
  LAddr6: SockAddr_in6;
begin
  case AIPVersion of
    Id_IPv4: begin
      LAddr.sin_family := Id_PF_INET4;
      TranslateStringToTInAddr(AIP, LAddr.sin_addr, Id_IPv4);
      LAddr.sin_port := HToNs(APort);
      CheckForSocketError(Libc.Connect(ASocket, LAddr, SizeOf(LAddr)));
    end;
    Id_IPv6: begin
      LAddr6.sin6_flowinfo := 0;
      LAddr6.sin6_scope_id := 0;
      LAddr6.sin6_family := Id_PF_INET6;
      TranslateStringToTInAddr(AIP, LAddr6.sin6_addr, Id_IPv6);
      LAddr6.sin6_port := HToNs(APort);
      CheckForSocketError(Libc.Connect(ASocket, Psockaddr(@LAddr6)^, SizeOf(LAddr6)));
    end;
    else begin
      IPVersionUnsupported;
    end;
  end;
end;

function TIdStackLinux.HostByName(const AHostName: string;
  const AIPVersion: TIdIPVersion = ID_DEFAULT_IP_VERSION): string;
var
  Lpa: pchar;
  Lsa: TInAddr;
  LHost: PHostEnt;
// ipv6
  LHints: TAddressInfo;
  LAddrInfo: PAddressInfo;
  LRetVal: integer;
begin
  case AIPVersion of
    Id_IPv4: begin
      LHost := Libc.GethostByName(PChar(AHostName));
      if (LHost <> nil) then begin
        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;
      LRetVal := getaddrinfo(pchar(AHostName), nil, @LHints, LAddrInfo);
      if LRetVal<>0 then begin
        if LRetVal = EAI_SYSTEM then begin
          RaiseLastOSError;
        end else begin
          raise EIdResolveError.CreateFmt(RSResolveError, [ahostname, gai_strerror(LRetVal), LRetVal]);
        end;
      end else begin
        result := TranslateTInAddrToString(LAddrInfo^.ai_addr^.sin_zero, Id_IPv6);
        freeaddrinfo(LAddrInfo);
      end;
    end;
    else
      Result := ''; // avoid warning
      IPVersionUnsupported;
  end;
end;

function TIdStackLinux.ReadHostName: string;
begin
  SetLength(Result, 250);
  GetHostName(PChar(Result), Length(Result));