blcksock.pas

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

    property TrustCertificate: string read FTrustCertificate write FTrustCertificate;

    {:Used for loading CA certificates from binary string. See to plugin documentation
     if this method is supported and how!}
    property CertCA: string read FCertCA write FCertCA;

    {:Used for loading CA certificates from disk file. See to plugin documentation
     if this method is supported and how!}
    property CertCAFile: string read FCertCAFile write FCertCAFile;

    {:If @true, then is verified client certificate. (it is good for writing
     SSL/TLS servers.) When you are not server, but you are client, then if this
     property is @true, verify servers certificate.}
    property VerifyCert: Boolean read FVerifyCert write FVerifyCert;

    {:channel type for possible SSH connections}
    property SSHChannelType: string read FSSHChannelType write FSSHChannelType;

    {:First argument of channel type for possible SSH connections}
    property SSHChannelArg1: string read FSSHChannelArg1 write FSSHChannelArg1;

    {:Second argument of channel type for possible SSH connections}
    property SSHChannelArg2: string read FSSHChannelArg2 write FSSHChannelArg2;
  end;

  {:@abstract(Default SSL plugin with no SSL support.)
   Dummy SSL plugin implementation for applications without SSL/TLS support.}
  TSSLNone = class (TCustomSSL)
  public
    {:See @inherited}
    function LibVersion: String; override;
    {:See @inherited}
    function LibName: String; override;
  end;

  {:@abstract(Record with definition of IP packet header.)
   For reading data from ICMP or RAW sockets.}
  TIPHeader = record
    VerLen: Byte;
    TOS: Byte;
    TotalLen: Word;
    Identifer: Word;
    FragOffsets: Word;
    TTL: Byte;
    Protocol: Byte;
    CheckSum: Word;
    SourceIp: LongWord;
    DestIp: LongWord;
    Options: LongWord;
  end;

  {:@abstract(Parent class of application protocol implementations.)
   By this class is defined common properties.}
  TSynaClient = Class(TObject)
  protected
    FTargetHost: string;
    FTargetPort: string;
    FIPInterface: string;
    FTimeout: integer;
    FUserName: string;
    FPassword: string;
  public
    constructor Create;
  published
    {:Specify terget server IP (or symbolic name). Default is 'localhost'.}
    property TargetHost: string read FTargetHost Write FTargetHost;

    {:Specify terget server port (or symbolic name).}
    property TargetPort: string read FTargetPort Write FTargetPort;

    {:Defined local socket address. (outgoing IP address). By default is used
     '0.0.0.0' as wildcard for default IP.}
    property IPInterface: string read FIPInterface Write FIPInterface;

    {:Specify default timeout for socket operations.}
    property Timeout: integer read FTimeout Write FTimeout;

    {:If protocol need user authorization, then fill here username.}
    property UserName: string read FUserName Write FUserName;

    {:If protocol need user authorization, then fill here password.}
    property Password: string read FPassword Write FPassword;
  end;

var
  {:Selected SSL plugin. Default is @link(TSSLNone).

   Do not change this value directly!!!

   Just add your plugin unit to your project uses instead. Each plugin unit have
   initialization code what modify this variable.}
  SSLImplementation: TSSLClass = TSSLNone;

implementation

{$IFDEF ONCEWINSOCK}
var
  WsaDataOnce: TWSADATA;
  e: ESynapseError;
{$ENDIF}


constructor TBlockSocket.Create;
begin
  CreateAlternate('');
end;

constructor TBlockSocket.CreateAlternate(Stub: string);
{$IFNDEF ONCEWINSOCK}
var
  e: ESynapseError;
{$ENDIF}
begin
  inherited Create;
  FDelayedOptions := TList.Create;
  FRaiseExcept := False;
{$IFDEF RAISEEXCEPT}
  FRaiseExcept := True;
{$ENDIF}
  FSocket := INVALID_SOCKET;
  FBuffer := '';
  FLastCR := False;
  FLastLF := False;
  FBinded := False;
  FNonBlockMode := False;
  FMaxLineLength := 0;
  FMaxSendBandwidth := 0;
  FNextSend := 0;
  FMaxRecvBandwidth := 0;
  FNextRecv := 0;
  FConvertLineEnd := False;
  FFamily := SF_Any;
  FFamilySave := SF_Any;
  FIP6used := False;
  FPreferIP4 := True;
  FInterPacketTimeout := True;
  FRecvCounter := 0;
  FSendCounter := 0;
  FSendMaxChunk := c64k;
  FStopFlag := False;
{$IFNDEF ONCEWINSOCK}
  if Stub = '' then
    Stub := DLLStackName;
  if not InitSocketInterface(Stub) then
  begin
    e := ESynapseError.Create('Error loading Socket interface (' + Stub + ')!');
    e.ErrorCode := 0;
    e.ErrorMessage := 'Error loading Socket interface (' + Stub + ')!';
    raise e;
  end;
  SockCheck(synsock.WSAStartup(WinsockLevel, FWsaDataOnce));
  ExceptCheck;
{$ENDIF}
end;

destructor TBlockSocket.Destroy;
var
  n: integer;
  p: TSynaOption;
begin
  CloseSocket;
{$IFNDEF ONCEWINSOCK}
  synsock.WSACleanup;
  DestroySocketInterface;
{$ENDIF}
  for n := FDelayedOptions.Count - 1 downto 0 do
    begin
      p := TSynaOption(FDelayedOptions[n]);
      p.Free;
    end;
  FDelayedOptions.Free;
  inherited Destroy;
end;

function TBlockSocket.IsNewApi: Boolean;
begin
  Result := synsock.IsNewApi(FamilyToAF(FFamily));
end;

function TBlockSocket.FamilyToAF(f: TSocketFamily): TAddrFamily;
begin
  case f of
    SF_ip4:
      Result := AF_INET;
    SF_ip6:
      Result := AF_INET6;
  else
    Result := AF_UNSPEC;
  end;
end;

procedure TBlockSocket.SetDelayedOption(const Value: TSynaOption);
var
  li: TLinger;
  x: integer;
  buf: TMemory;
begin
  case value.Option of
    SOT_Linger:
      begin
        {$IFDEF CIL}
        li := TLinger.Create(Value.Enabled, Value.Value div 1000);
        synsock.SetSockOptObj(FSocket, integer(SOL_SOCKET), integer(SO_LINGER), li);
        {$ELSE}
        li.l_onoff := Ord(Value.Enabled);
        li.l_linger := Value.Value div 1000;
        buf := @li;
        synsock.SetSockOpt(FSocket, integer(SOL_SOCKET), integer(SO_LINGER), buf, SizeOf(li));
        {$ENDIF}
      end;
    SOT_RecvBuff:
      begin
        {$IFDEF CIL}
        buf := System.BitConverter.GetBytes(value.Value);
        {$ELSE}
        buf := @Value.Value;
        {$ENDIF}
        synsock.SetSockOpt(FSocket, integer(SOL_SOCKET), integer(SO_RCVBUF),
          buf, SizeOf(Value.Value));
      end;
    SOT_SendBuff:
      begin
        {$IFDEF CIL}
        buf := System.BitConverter.GetBytes(value.Value);
        {$ELSE}
        buf := @Value.Value;
        {$ENDIF}
        synsock.SetSockOpt(FSocket, integer(SOL_SOCKET), integer(SO_SNDBUF),
          buf, SizeOf(Value.Value));
      end;
    SOT_NonBlock:
      begin
        FNonBlockMode := Value.Enabled;
        x := Ord(FNonBlockMode);
        synsock.IoctlSocket(FSocket, FIONBIO, x);
      end;
    SOT_RecvTimeout:
      begin
        {$IFDEF CIL}
        buf := System.BitConverter.GetBytes(value.Value);
        {$ELSE}
        buf := @Value.Value;
        {$ENDIF}
        synsock.SetSockOpt(FSocket, integer(SOL_SOCKET), integer(SO_RCVTIMEO),
          buf, SizeOf(Value.Value));
      end;
    SOT_SendTimeout:
      begin
        {$IFDEF CIL}
        buf := System.BitConverter.GetBytes(value.Value);
        {$ELSE}
        buf := @Value.Value;
        {$ENDIF}
        synsock.SetSockOpt(FSocket, integer(SOL_SOCKET), integer(SO_SNDTIMEO),
          buf, SizeOf(Value.Value));
      end;
    SOT_Reuse:
      begin
        x := Ord(Value.Enabled);
        {$IFDEF CIL}
        buf := System.BitConverter.GetBytes(x);
        {$ELSE}
        buf := @x;
        {$ENDIF}
        synsock.SetSockOpt(FSocket, integer(SOL_SOCKET), integer(SO_REUSEADDR), buf, SizeOf(x));
      end;
    SOT_TTL:
      begin
        {$IFDEF CIL}
        buf := System.BitConverter.GetBytes(value.Value);
        {$ELSE}
        buf := @Value.Value;
        {$ENDIF}
        if FIP6Used then
          synsock.SetSockOpt(FSocket, integer(IPPROTO_IPV6), integer(IPV6_UNICAST_HOPS),
            buf, SizeOf(Value.Value))
        else
          synsock.SetSockOpt(FSocket, integer(IPPROTO_IP), integer(IP_TTL),
            buf, SizeOf(Value.Value));
      end;
    SOT_Broadcast:
      begin
//#todo1 broadcasty na IP6
        x := Ord(Value.Enabled);
        {$IFDEF CIL}
        buf := System.BitConverter.GetBytes(x);
        {$ELSE}
        buf := @x;
        {$ENDIF}
        synsock.SetSockOpt(FSocket, integer(SOL_SOCKET), integer(SO_BROADCAST), buf, SizeOf(x));
      end;
    SOT_MulticastTTL:
      begin
        {$IFDEF CIL}
        buf := System.BitConverter.GetBytes(value.Value);
        {$ELSE}
        buf := @Value.Value;
        {$ENDIF}
        if FIP6Used then
          synsock.SetSockOpt(FSocket, integer(IPPROTO_IPV6), integer(IPV6_MULTICAST_HOPS),
            buf, SizeOf(Value.Value))
        else
          synsock.SetSockOpt(FSocket, integer(IPPROTO_IP), integer(IP_MULTICAST_TTL),
            buf, SizeOf(Value.Value));
      end;
   SOT_MulticastLoop:
      begin
        x := Ord(Value.Enabled);
        {$IFDEF CIL}
        buf := System.BitConverter.GetBytes(x);
        {$ELSE}
        buf := @x;
        {$ENDIF}
        if FIP6Used then