diff --git a/asn1util.pas b/asn1util.pas index af3b1ca..a37cf42 100644 --- a/asn1util.pas +++ b/asn1util.pas @@ -1,5 +1,5 @@ {==============================================================================| -| Project : Delphree - Synapse | 001.003.005 | +| Project : Delphree - Synapse | 001.003.006 | |==============================================================================| | Content: support for ASN.1 BER coding and decoding | |==============================================================================| @@ -45,7 +45,6 @@ |==============================================================================} {$Q-} -{$WEAKPACKAGEUNIT ON} unit ASN1Util; diff --git a/blcksock.pas b/blcksock.pas index 4b55912..4681ce6 100644 --- a/blcksock.pas +++ b/blcksock.pas @@ -1,5 +1,5 @@ {==============================================================================| -| Project : Delphree - Synapse | 006.006.001 | +| Project : Delphree - Synapse | 007.002.014 | |==============================================================================| | Content: Library base | |==============================================================================| @@ -61,6 +61,13 @@ count of created and destroyed sockets. It eliminate possible small resource leak on Windows systems too. } +{$IFDEF VER125} + {$DEFINE BCB} +{$ENDIF} +{$IFDEF BCB} + {$ObjExportAll On} +{$ENDIF} + unit blcksock; interface @@ -70,14 +77,20 @@ uses {$IFDEF LINUX} Libc, kernelioctl, {$ELSE} - Windows, WinSock, + Windows, {$ENDIF} synsock, SynaUtil, SynaCode, SynaSSL; const - cLocalhost = 'localhost'; + + SynapseRelease = '31'; + + cLocalhost = '127.0.0.1'; cAnyHost = '0.0.0.0'; cBroadcast = '255.255.255.255'; + c6Localhost = '::1'; + c6AnyHost = '::0'; + c6Broadcast = 'ffff::1'; cAnyPort = '0'; CR = #$0d; LF = #$0a; @@ -116,28 +129,76 @@ type THookDataFilter = procedure(Sender: TObject; var Value: string) of object; + THookCreateSocket = procedure(Sender: TObject) of object; + + TSocketFamily = ( + SF_Any, + SF_IP4, + SF_IP6 + ); + + TSocksType = ( + ST_Socks5, + ST_Socks4 + ); + + TSynaSin = record + usedip6: Boolean; + isip4: Boolean; + ip4: TSockAddrIn; + isip6: Boolean; + ip6: TSockAddrIn6; + end; + + TSynaOptionType = ( + SOT_Linger, + SOT_RecvBuff, + SOT_SendBuff, + SOT_NonBlock, + SOT_RecvTimeout, + SOT_SendTimeout, + SOT_Reuse, + SOT_TTL, + SOT_Broadcast, + SOT_MulticastTTL, + SOT_MulticastLoop + ); + + TSynaOption = record + Option: TSynaOptionType; + Enabled: Boolean; + Value: Integer; + end; + PSynaOption = ^TSynaOption; + TBlockSocket = class(TObject) private FOnStatus: THookSocketStatus; FOnReadFilter: THookDataFilter; FOnWriteFilter: THookDataFilter; + FOnCreateSocket: THookCreateSocket; FWsaData: TWSADATA; - FLocalSin: TSockAddrIn; - FRemoteSin: TSockAddrIn; - FLastError: Integer; - FLastErrorDesc: string; + FLocalSin: TSynaSin; + FRemoteSin: TSynaSin; FBuffer: string; FRaiseExcept: Boolean; FNonBlockMode: Boolean; FMaxLineLength: Integer; FMaxSendBandwidth: Integer; - FNextSend: Cardinal; + FNextSend: ULong; FMaxRecvBandwidth: Integer; - FNextRecv: Cardinal; + FNextRecv: ULong; FConvertLineEnd: Boolean; FLastCR: Boolean; FLastLF: Boolean; FBinded: Boolean; + FFamily: TSocketFamily; + FFamilySave: TSocketFamily; + FIP6used: Boolean; + FPreferIP4: Boolean; + FDelayedOptions: TList; + FInterPacketTimeout: Boolean; + FFDSet: TFDSet; function GetSizeRecvBuffer: Integer; procedure SetSizeRecvBuffer(Size: Integer); function GetSizeSendBuffer: Integer; @@ -145,23 +206,32 @@ type procedure SetNonBlockMode(Value: Boolean); procedure SetTTL(TTL: integer); function GetTTL:integer; + function IsNewApi: Boolean; + procedure SetFamily(Value: TSocketFamily); + procedure SetSocket(Value: TSocket); protected FSocket: TSocket; - FProtocol: Integer; - procedure CreateSocket; virtual; - procedure AutoCreateSocket; - procedure SetSin(var Sin: TSockAddrIn; IP, Port: string); - function GetSinIP(Sin: TSockAddrIn): string; - function GetSinPort(Sin: TSockAddrIn): Integer; + FLastError: Integer; + FLastErrorDesc: string; + procedure SetDelayedOption(Value: TSynaOption); + procedure DelayedOption(Value: TSynaOption); + procedure ProcessDelayedOptions; + procedure InternalCreateSocket(Sin: TSynaSin); + procedure SetSin(var Sin: TSynaSin; IP, Port: string); + function GetSinIP(Sin: TSynaSin): string; + function GetSinPort(Sin: TSynaSin): Integer; procedure DoStatus(Reason: THookSocketReason; const Value: string); procedure DoReadFilter(Buffer: Pointer; var Length: Integer); procedure DoWriteFilter(Buffer: Pointer; var Length: Integer); - procedure LimitBandwidth(Length: Integer; MaxB: integer; var Next: Cardinal); + procedure DoCreateSocket; + procedure LimitBandwidth(Length: Integer; MaxB: integer; var Next: ULong); procedure SetBandwidth(Value: Integer); public constructor Create; constructor CreateAlternate(Stub: string); destructor Destroy; override; + procedure CreateSocket; + procedure CreateSocketByName(const Value: String); procedure CloseSocket; virtual; procedure Bind(IP, Port: string); procedure Connect(IP, Port: string); virtual; @@ -181,12 +251,15 @@ type function WaitingData: Integer; virtual; function WaitingDataEx: Integer; procedure SetLinger(Enable: Boolean; Linger: Integer); + procedure GetSinLocal; + procedure GetSinRemote; procedure GetSins; function SockCheck(SockResult: Integer): Integer; procedure ExceptCheck; function LocalName: string; procedure ResolveNameToIP(Name: string; IPList: TStrings); function ResolveName(Name: string): string; + function ResolveIPToName(IP: string): string; function ResolvePort(Port: string): Word; procedure SetRemoteSin(IP, Port: string); function GetLocalSinIP: string; virtual; @@ -200,21 +273,22 @@ type function RecvBufferFrom(Buffer: Pointer; Length: Integer): Integer; virtual; function GroupCanRead(const SocketList: TList; Timeout: Integer; const CanReadList: TList): Boolean; - function EnableReuse(Value: Boolean): Boolean; + procedure EnableReuse(Value: Boolean); + procedure SetTimeout(Timeout: Integer); + procedure SetSendTimeout(Timeout: Integer); + procedure SetRecvTimeout(Timeout: Integer); - //See 'winsock2.txt' file in distribute package! - function SetTimeout(Timeout: Integer): Boolean; - function SetSendTimeout(Timeout: Integer): Boolean; - function SetRecvTimeout(Timeout: Integer): Boolean; + function StrToIP6(const value: string): TSockAddrIn6; + function IP6ToStr(const value: TSockAddrIn6): string; + + function GetSocketType: integer; Virtual; + function GetSocketProtocol: integer; Virtual; - property LocalSin: TSockAddrIn read FLocalSin; - property RemoteSin: TSockAddrIn read FRemoteSin; published class function GetErrorDesc(ErrorCode: Integer): string; - property Socket: TSocket read FSocket write FSocket; + property Socket: TSocket read FSocket write SetSocket; property LastError: Integer read FLastError; property LastErrorDesc: string read FLastErrorDesc; - property Protocol: Integer read FProtocol; property LineBuffer: string read FBuffer write FBuffer; property RaiseExcept: Boolean read FRaiseExcept write FRaiseExcept; property SizeRecvBuffer: Integer read GetSizeRecvBuffer write SetSizeRecvBuffer; @@ -227,9 +301,16 @@ type property MaxBandwidth: Integer Write SetBandwidth; property ConvertLineEnd: Boolean read FConvertLineEnd Write FConvertLineEnd; property TTL: Integer read GetTTL Write SetTTL; + property Family: TSocketFamily read FFamily Write SetFamily; + property PreferIP4: Boolean read FPreferIP4 Write FPreferIP4; + property IP6used: Boolean read FIP6used; + property InterPacketTimeout: Boolean read FInterPacketTimeout Write FInterPacketTimeout; + property LocalSin: TSynaSin read FLocalSin write FLocalSin; + property RemoteSin: TSynaSin read FRemoteSin write FRemoteSin; property OnStatus: THookSocketStatus read FOnStatus write FOnStatus; property OnReadFilter: THookDataFilter read FOnReadFilter write FOnReadFilter; property OnWriteFilter: THookDataFilter read FOnWriteFilter write FOnWriteFilter; + property OnCreateSocket: THookCreateSocket read FOnCreateSocket write FOnCreateSocket; end; TSocksBlockSocket = class(TBlockSocket) @@ -249,6 +330,7 @@ type FSocksRemoteIP: string; FSocksRemotePort: string; FBypassFlag: Boolean; + FSocksType: TSocksType; function SocksCode(IP, Port: string): string; function SocksDecode(Value: string): integer; public @@ -264,6 +346,7 @@ type property UsingSocks: Boolean read FUsingSocks; property SocksResolver: Boolean read FSocksResolver write FSocksResolver; property SocksLastError: integer read FSocksLastError; + property SocksType: TSocksType read FSocksType write FSocksType; end; TTCPBlockSocket = class(TSocksBlockSocket) @@ -293,11 +376,9 @@ type procedure HTTPTunnelDoConnect(IP, Port: string); public constructor Create; - destructor Destroy; override; - procedure CreateSocket; override; procedure CloseSocket; override; function WaitingData: Integer; override; - procedure Listen; + procedure Listen; virtual; function Accept: TSocket; procedure Connect(IP, Port: string); override; procedure SSLDoConnect; @@ -316,6 +397,8 @@ type function SSLGetPeerIssuerHash: Cardinal; function SSLGetPeerFingerprint: string; function SSLCheck: Boolean; + function GetSocketType: integer; override; + function GetSocketProtocol: integer; override; published property SSLEnabled: Boolean read FSslEnabled write SetSslEnabled; property SSLBypass: Boolean read FSslBypass write FSslBypass; @@ -342,8 +425,7 @@ type function GetMulticastTTL:integer; public destructor Destroy; override; - procedure CreateSocket; override; - function EnableBroadcast(Value: Boolean): Boolean; + procedure EnableBroadcast(Value: Boolean); procedure Connect(IP, Port: string); override; function SendBuffer(Buffer: Pointer; Length: Integer): Integer; override; function RecvBuffer(Buffer: Pointer; Length: Integer): Integer; override; @@ -351,21 +433,23 @@ type function RecvBufferFrom(Buffer: Pointer; Length: Integer): Integer; override; procedure AddMulticast(MCastIP:string); procedure DropMulticast(MCastIP:string); - function EnableMulticastLoop(Value: Boolean): Boolean; + procedure EnableMulticastLoop(Value: Boolean); + function GetSocketType: integer; override; + function GetSocketProtocol: integer; override; published property MulticastTTL: Integer read GetMulticastTTL Write SetMulticastTTL; end; - //See 'winsock2.txt' file in distribute package! TICMPBlockSocket = class(TBlockSocket) public - procedure CreateSocket; override; + function GetSocketType: integer; override; + function GetSocketProtocol: integer; override; end; - //See 'winsock2.txt' file in distribute package! TRAWBlockSocket = class(TBlockSocket) public - procedure CreateSocket; override; + function GetSocketType: integer; override; + function GetSocketProtocol: integer; override; end; TIPHeader = record @@ -399,12 +483,6 @@ type implementation -type - TMulticast = record - MCastAddr : u_long; - MCastIfc : u_long; - end; - {$IFDEF ONCEWINSOCK} var WsaDataOnce: TWSADATA; @@ -413,39 +491,8 @@ var constructor TBlockSocket.Create; -{$IFNDEF ONCEWINSOCK} -var - e: ESynapseError; -{$ENDIF} begin - inherited Create; - FRaiseExcept := False; - FSocket := INVALID_SOCKET; - FProtocol := IPPROTO_IP; - FBuffer := ''; - FLastCR := False; - FLastLF := False; - FBinded := False; - FNonBlockMode := False; - FMaxLineLength := 0; - FMaxSendBandwidth := 0; - FNextSend := 0; - FMaxRecvBandwidth := 0; - FNextRecv := 0; - FConvertLineEnd := False; -{$IFDEF ONCEWINSOCK} - FWsaData := WsaDataOnce; -{$ELSE} - if not InitSocketInterface('') then - begin - e := ESynapseError.Create('Error loading Winsock DLL!'); - e.ErrorCode := 0; - e.ErrorMessage := 'Error loading Winsock DLL!'; - raise e; - end; - SockCheck(synsock.WSAStartup($101, FWsaData)); - ExceptCheck; -{$ENDIF} + CreateAlternate(''); end; constructor TBlockSocket.CreateAlternate(Stub: string); @@ -455,10 +502,13 @@ var {$ENDIF} begin inherited Create; + FDelayedOptions := TList.Create; FRaiseExcept := False; FSocket := INVALID_SOCKET; - FProtocol := IPPROTO_IP; FBuffer := ''; + FLastCR := False; + FLastLF := False; + FBinded := False; FNonBlockMode := False; FMaxLineLength := 0; FMaxSendBandwidth := 0; @@ -466,134 +516,435 @@ begin FMaxRecvBandwidth := 0; FNextRecv := 0; FConvertLineEnd := False; + FFamily := SF_Any; + FFamilySave := SF_Any; + FIP6used := False; + FPreferIP4 := True; + FInterPacketTimeout := True; {$IFDEF ONCEWINSOCK} FWsaData := WsaDataOnce; {$ELSE} + if Stub = '' then + Stub := DLLStackName; if not InitSocketInterface(Stub) then begin - e := ESynapseError.Create('Error loading alternate Winsock DLL (' + Stub + ')!'); + e := ESynapseError.Create('Error loading Socket interface (' + Stub + ')!'); e.ErrorCode := 0; - e.ErrorMessage := 'Error loading Winsock DLL (' + Stub + ')!'; + e.ErrorMessage := 'Error loading Socket interface (' + Stub + ')!'; raise e; end; - SockCheck(synsock.WSAStartup($101, FWsaData)); + SockCheck(synsock.WSAStartup(WinsockLevel, FWsaData)); ExceptCheck; {$ENDIF} end; destructor TBlockSocket.Destroy; +var + n: integer; begin CloseSocket; {$IFNDEF ONCEWINSOCK} synsock.WSACleanup; DestroySocketInterface; {$ENDIF} + for n := FDelayedOptions.Count - 1 downto 0 do + Dispose(PSynaOption(FDelayedOptions[n])); + FDelayedOptions.Free; inherited Destroy; end; -procedure TBlockSocket.SetSin(var Sin: TSockAddrIn; IP, Port: string); +function TBlockSocket.IsNewApi: Boolean; +begin + Result := SockEnhancedApi; + if not Result then + Result := (FFamily = SF_ip6) and SockWship6Api; +end; + +procedure TBlockSocket.SetDelayedOption(Value: TSynaOption); +var + li: TLinger; + x: integer; +begin + case value.Option of + SOT_Linger: + begin + li.l_onoff := Ord(Value.Enabled); + li.l_linger := Value.Value div 1000; + synsock.SetSockOpt(FSocket, SOL_SOCKET, SO_LINGER, @li, SizeOf(li)); + end; + SOT_RecvBuff: + begin + synsock.SetSockOpt(FSocket, SOL_SOCKET, SO_RCVBUF, + @Value.Value, SizeOf(Value.Value)); + end; + SOT_SendBuff: + begin + synsock.SetSockOpt(FSocket, SOL_SOCKET, SO_SNDBUF, + @Value.Value, SizeOf(Value.Value)); + end; + SOT_NonBlock: + begin + FNonBlockMode := Value.Enabled; + x := Ord(FNonBlockMode); + synsock.IoctlSocket(FSocket, FIONBIO, u_long(x)); + end; + SOT_RecvTimeout: + begin + synsock.SetSockOpt(FSocket, SOL_SOCKET, SO_RCVTIMEO, + @Value.Value, SizeOf(Value.Value)); + end; + SOT_SendTimeout: + begin + synsock.SetSockOpt(FSocket, SOL_SOCKET, SO_SNDTIMEO, + @Value.Value, SizeOf(Value.Value)); + end; + SOT_Reuse: + begin + x := Ord(Value.Enabled); + synsock.SetSockOpt(FSocket, SOL_SOCKET, SO_REUSEADDR, @x, SizeOf(x)); + end; + SOT_TTL: + begin + if FIP6Used then + synsock.SetSockOpt(FSocket, IPPROTO_IPV6, IPV6_UNICAST_HOPS, + @Value.Value, SizeOf(Value.Value)) + else + synsock.SetSockOpt(FSocket, IPPROTO_IP, IP_TTL, + @Value.Value, SizeOf(Value.Value)); + end; + SOT_Broadcast: + begin +//#todo1 broadcasty na IP6 + x := Ord(Value.Enabled); + synsock.SetSockOpt(FSocket, SOL_SOCKET, SO_BROADCAST, @x, SizeOf(x)); + end; + SOT_MulticastTTL: + begin + if FIP6Used then + synsock.SetSockOpt(FSocket, IPPROTO_IPV6, IPV6_MULTICAST_HOPS, + @Value.Value, SizeOf(Value.Value)) + else + synsock.SetSockOpt(FSocket, IPPROTO_IP, IP_MULTICAST_TTL, + @Value.Value, SizeOf(Value.Value)); + end; + SOT_MulticastLoop: + begin + x := Ord(Value.Enabled); + if FIP6Used then + synsock.SetSockOpt(FSocket, IPPROTO_IPV6, IPV6_MULTICAST_LOOP, @x, SizeOf(x)) + else + synsock.SetSockOpt(FSocket, IPPROTO_IP, IP_MULTICAST_LOOP, @x, SizeOf(x)); + end; + end; +end; + +procedure TBlockSocket.DelayedOption(Value: TSynaOption); +var + d: PSynaOption; +begin + if FSocket = INVALID_SOCKET then + begin + new(d); + d^ := Value; + FDelayedOptions.Insert(0, d); + end + else + SetDelayedOption(Value); +end; + +procedure TBlockSocket.ProcessDelayedOptions; +var + n: integer; + d: PSynaOption; +begin + for n := FDelayedOptions.Count - 1 downto 0 do + begin + d := FDelayedOptions[n]; + SetDelayedOption(d^); + Dispose(d); + end; + FDelayedOptions.Clear; +end; + +procedure TBlockSocket.SetSin(var Sin: TSynaSin; IP, Port: string); type pu_long = ^u_long; var ProtoEnt: PProtoEnt; ServEnt: PServEnt; HostEnt: PHostEnt; + Hints: TAddrInfo; + Addr: PAddrInfo; + AddrNext: PAddrInfo; + r: integer; begin DoStatus(HR_ResolvingBegin, IP + ':' + Port); - SynSockCS.Enter; - try - FillChar(Sin, Sizeof(Sin), 0); - Sin.sin_family := AF_INET; - ProtoEnt := synsock.GetProtoByNumber(FProtocol); - ServEnt := nil; - if ProtoEnt <> nil then - ServEnt := synsock.GetServByName(PChar(Port), ProtoEnt^.p_name); - if ServEnt = nil then - Sin.sin_port := synsock.htons(StrToIntDef(Port, 0)) + FillChar(Sin, Sizeof(Sin), 0); + Sin.isip4 := False; + Sin.isip6 := False; + Sin.usedip6 := False; + //for prelimitary IP6 support try fake Family by given IP + if SockWship6Api and (FFamily = SF_Any) then + begin + if IsIP(IP) then + FFamily := SF_IP4 else - Sin.sin_port := ServEnt^.s_port; - if IP = cBroadcast then - Sin.sin_addr.s_addr := u_long(INADDR_BROADCAST) - else - begin - Sin.sin_addr.s_addr := synsock.inet_addr(PChar(IP)); - if SIn.sin_addr.s_addr = u_long(INADDR_NONE) then + if IsIP6(IP) then + FFamily := SF_IP6 + else + if FPreferIP4 then + FFamily := SF_IP4 + else + FFamily := SF_IP6; + end; + if not IsNewApi then + begin + SynSockCS.Enter; + try + Sin.isip4 := True; + Sin.ip4.sin_family := AF_INET; + ProtoEnt := synsock.GetProtoByNumber(GetSocketProtocol); + ServEnt := nil; + if ProtoEnt <> nil then + ServEnt := synsock.GetServByName(PChar(Port), ProtoEnt^.p_name); + if ServEnt = nil then + Sin.ip4.sin_port := synsock.htons(StrToIntDef(Port, 0)) + else + Sin.ip4.sin_port := ServEnt^.s_port; + if IP = cBroadcast then + Sin.ip4.sin_addr.s_addr := u_long(INADDR_BROADCAST) + else begin - HostEnt := synsock.GetHostByName(PChar(IP)); - if HostEnt <> nil then - SIn.sin_addr.S_addr := u_long(Pu_long(HostEnt^.h_addr_list^)^); + Sin.ip4.sin_addr.s_addr := synsock.inet_addr(PChar(IP)); + if Sin.ip4.sin_addr.s_addr = u_long(INADDR_NONE) then + begin + HostEnt := synsock.GetHostByName(PChar(IP)); + if HostEnt <> nil then + Sin.ip4.sin_addr.S_addr := u_long(Pu_long(HostEnt^.h_addr_list^)^); + end; end; + finally + SynSockCS.Leave; + end; + end + else + begin + Addr := nil; + try + FillChar(Hints, Sizeof(Hints), 0); + //if socket exists, then use their type, else use users selection + if FSocket = INVALID_SOCKET then + case FFamily of + SF_Any: Hints.ai_family := AF_UNSPEC; + SF_IP4: Hints.ai_family := AF_INET; + SF_IP6: Hints.ai_family := AF_INET6; + end + else + if FIP6Used then + Hints.ai_family := AF_INET6 + else + Hints.ai_family := AF_INET; + Hints.ai_socktype := GetSocketType; + Hints.ai_protocol := GetSocketprotocol; + if Hints.ai_socktype = SOCK_RAW then + begin + Hints.ai_socktype := 0; + Hints.ai_protocol := 0; + r := synsock.GetAddrInfo(PChar(IP), nil, @Hints, Addr); + end + else + begin + if IP = cAnyHost then + begin + Hints.ai_flags := AI_PASSIVE; + r := synsock.GetAddrInfo(nil, PChar(Port), @Hints, Addr); + end + else + if IP = cLocalhost then + begin + r := synsock.GetAddrInfo(nil, PChar(Port), @Hints, Addr); + end + else + begin + r := synsock.GetAddrInfo(PChar(IP), PChar(Port), @Hints, Addr); + end; + end; + if r = 0 then + begin + AddrNext := Addr; + while not (AddrNext = nil) do + begin + if not(Sin.isip4) and (AddrNext^.ai_family = AF_INET) then + begin + Move(AddrNext^.ai_addr^, Sin.IP4, SizeOf(Sin.IP4)); + sin.isip4 := True; + end; + if not(Sin.isip6) and (AddrNext^.ai_family = AF_INET6) then + begin + Move(AddrNext^.ai_addr^, Sin.IP6, SizeOf(Sin.IP6)); + sin.isip6 := True; + end; + AddrNext := AddrNext^.ai_next; + end; + if Sin.isip4 or Sin.isip6 then + if FPreferIP4 then + Sin.usedip6 := not(Sin.isip4) + else + Sin.usedip6 := Sin.isip6; + end; + finally + if Assigned(Addr) then + synsock.FreeAddrInfo(Addr); end; - finally - SynSockCS.Leave; end; DoStatus(HR_ResolvingEnd, IP + ':' + Port); end; -function TBlockSocket.GetSinIP(Sin: TSockAddrIn): string; +function TBlockSocket.GetSinIP(Sin: TSynaSin): string; var p: PChar; + host, serv: string; + hostlen, servlen: integer; + r: integer; begin - p := synsock.inet_ntoa(Sin.sin_addr); - if p = nil then - Result := '' + Result := ''; + if not IsNewApi then + begin + p := synsock.inet_ntoa(Sin.ip4.sin_addr); + if p <> nil then + Result := p; + end else - Result := p; + begin + hostlen := NI_MAXHOST; + servlen := NI_MAXSERV; + setlength(host, hostlen); + setlength(serv, servlen); + if FIP6Used then + r := getnameinfo(@sin.ip6, SizeOf(sin.ip6), PChar(host), hostlen, + PChar(serv), servlen, NI_NUMERICHOST + NI_NUMERICSERV) + else + r := getnameinfo(@sin.ip4, SizeOf(sin.ip4), PChar(host), hostlen, + PChar(serv), servlen, NI_NUMERICHOST + NI_NUMERICSERV); + if r = 0 then + Result := PChar(host); + end; end; -function TBlockSocket.GetSinPort(Sin: TSockAddrIn): Integer; +function TBlockSocket.GetSinPort(Sin: TSynaSin): Integer; begin - Result := synsock.ntohs(Sin.sin_port); + if FIP6Used then + Result := synsock.ntohs(Sin.ip6.sin6_port) + else + Result := synsock.ntohs(Sin.ip4.sin_port); end; procedure TBlockSocket.CreateSocket; +var + sin: TSynaSin; begin - FBuffer := ''; - FBinded := False; - if FSocket = INVALID_SOCKET then - FLastError := synsock.WSAGetLastError - else - FLastError := 0; - ExceptCheck; - DoStatus(HR_SocketCreate, ''); + //dummy for SF_Any Family mode + FLastError := 0; + if (FFamily <> SF_Any) and (FSocket = INVALID_SOCKET) then + begin + FillChar(Sin, Sizeof(Sin), 0); + sin.usedip6 := FFamily = SF_IP6; + InternalCreateSocket(Sin); + end; end; -procedure TBlockSocket.AutoCreateSocket; +procedure TBlockSocket.CreateSocketByName(const Value: String); +var + sin: TSynaSin; begin + FLastError := 0; if FSocket = INVALID_SOCKET then - CreateSocket; + begin + SetSin(sin, value, '0'); + InternalCreateSocket(Sin); + end; +end; + +procedure TBlockSocket.InternalCreateSocket(Sin: TSynaSin); +begin + FLastError := 0; + if FSocket = INVALID_SOCKET then + begin + FBuffer := ''; + FBinded := False; + FIP6Used := Sin.usedip6; + if FIP6Used then + FSocket := synsock.Socket(PF_INET6, GetSocketType, GetSocketProtocol) + else + FSocket := synsock.Socket(PF_INET, GetSocketType, GetSocketProtocol); + if FSocket = INVALID_SOCKET then + FLastError := synsock.WSAGetLastError; + FD_ZERO(FFDSet); + FD_SET(FSocket, FFDSet); + ExceptCheck; + if FIP6used then + DoStatus(HR_SocketCreate, 'IPv6') + else + DoStatus(HR_SocketCreate, 'IPv4'); + ProcessDelayedOptions; + DoCreateSocket; + end; end; procedure TBlockSocket.CloseSocket; +var + n: integer; begin synsock.CloseSocket(FSocket); FSocket := INVALID_SOCKET; + for n := FDelayedOptions.Count - 1 downto 0 do + Dispose(PSynaOption(FDelayedOptions[n])); + FDelayedOptions.Clear; + FFamily := FFamilySave; + FLastError := 0; DoStatus(HR_SocketClose, ''); end; procedure TBlockSocket.Bind(IP, Port: string); var - Sin: TSockAddrIn; - Len: Integer; + Sin: TSynaSin; begin - AutoCreateSocket; - SetSin(Sin, IP, Port); - SockCheck(synsock.Bind(FSocket, Sin, SizeOf(Sin))); - Len := SizeOf(FLocalSin); - synsock.GetSockName(FSocket, FLocalSin, Len); - FBuffer := ''; - FBinded := True; - ExceptCheck; - DoStatus(HR_Bind, IP + ':' + Port); + FLastError := 0; + if (FSocket <> INVALID_SOCKET) + or not((FFamily = SF_ANY) and (IP = cAnyHost) and (Port = cAnyPort)) then + begin + SetSin(Sin, IP, Port); + if FSocket = INVALID_SOCKET then + begin + InternalCreateSocket(Sin); + FIP6Used := Sin.usedip6; + end; + if FIP6Used then + SockCheck(synsock.Bind(FSocket, @Sin.ip6, SizeOf(Sin.ip6))) + else + SockCheck(synsock.Bind(FSocket, @Sin.ip4, SizeOf(Sin.ip4))); + GetSinLocal; + FBuffer := ''; + FBinded := True; + ExceptCheck; + DoStatus(HR_Bind, IP + ':' + Port); + end; end; procedure TBlockSocket.Connect(IP, Port: string); var - Sin: TSockAddrIn; + Sin: TSynaSin; begin - AutoCreateSocket; SetSin(Sin, IP, Port); - SockCheck(synsock.Connect(FSocket, Sin, SizeOf(Sin))); + if FSocket = INVALID_SOCKET then + begin + InternalCreateSocket(Sin); + FIP6Used := Sin.usedip6; + end; + if FIP6Used then + SockCheck(synsock.Connect(FSocket, @Sin.ip6, SizeOf(Sin.ip6))) + else + SockCheck(synsock.Connect(FSocket, @Sin.ip4, SizeOf(Sin.ip4))); GetSins; FBuffer := ''; FLastCR := False; @@ -602,14 +953,54 @@ begin DoStatus(HR_Connect, IP + ':' + Port); end; -procedure TBlockSocket.GetSins; +procedure TBlockSocket.GetSinLocal; var Len: Integer; begin - Len := SizeOf(FLocalSin); - synsock.GetSockName(FSocket, FLocalSin, Len); - Len := SizeOf(FRemoteSin); - synsock.GetPeerName(FSocket, FremoteSin, Len); + FillChar(FLocalSin, Sizeof(FLocalSin), 0); + FLocalSin.isip4 := False; + FLocalSin.isip6 := False; + FLocalSin.usedip6 := False; + if FIP6Used then + begin + Len := SizeOf(FLocalSin.ip6); + synsock.GetSockName(FSocket, @FLocalSin.ip6, Len); + FLocalSin.isip6 := True; + end + else + begin + Len := SizeOf(FLocalSin.ip4); + synsock.GetSockName(FSocket, @FLocalSin.ip4, Len); + FLocalSin.isip4 := True; + end; +end; + +procedure TBlockSocket.GetSinRemote; +var + Len: Integer; +begin + FillChar(FRemoteSin, Sizeof(FRemoteSin), 0); + FRemoteSin.isip4 := False; + FRemoteSin.isip6 := False; + FRemoteSin.usedip6 := False; + if FIP6Used then + begin + Len := SizeOf(FRemoteSin.ip6); + synsock.GetPeerName(FSocket, @FRemoteSin.ip6, Len); + FRemoteSin.isip6 := True; + end + else + begin + Len := SizeOf(FRemoteSin.ip4); + synsock.GetPeerName(FSocket, @FRemoteSin.ip4, Len); + FRemoteSin.isip4 := True; + end; +end; + +procedure TBlockSocket.GetSins; +begin + GetSinLocal; + GetSinRemote; end; procedure TBlockSocket.SetBandwidth(Value: Integer); @@ -618,10 +1009,10 @@ begin MaxRecvBandwidth := Value; end; -procedure TBlockSocket.LimitBandwidth(Length: Integer; MaxB: integer; var Next: Cardinal); +procedure TBlockSocket.LimitBandwidth(Length: Integer; MaxB: integer; var Next: ULong); var - x: Cardinal; - y: Cardinal; + x: ULong; + y: ULong; begin if MaxB > 0 then begin @@ -635,7 +1026,7 @@ begin sleep(x); end; end; - Next := y + Trunc((Length / MaxB) * 1000); + Next := GetTick + Trunc((Length / MaxB) * 1000); end; end; @@ -643,7 +1034,7 @@ function TBlockSocket.SendBuffer(Buffer: Pointer; Length: Integer): Integer; begin LimitBandwidth(Length, FMaxSendBandwidth, FNextsend); DoWriteFilter(Buffer, Length); - Result := synsock.Send(FSocket, Buffer^, Length, 0); + Result := synsock.Send(FSocket, Buffer^, Length, MSG_NOSIGNAL); SockCheck(Result); ExceptCheck; DoStatus(HR_WriteCount, IntToStr(Result)); @@ -662,7 +1053,7 @@ end; function TBlockSocket.RecvBuffer(Buffer: Pointer; Length: Integer): Integer; begin LimitBandwidth(Length, FMaxRecvBandwidth, FNextRecv); - Result := synsock.Recv(FSocket, Buffer^, Length, 0); + Result := synsock.Recv(FSocket, Buffer^, Length, MSG_NOSIGNAL); if Result = 0 then FLastError := WSAECONNRESET else @@ -677,10 +1068,12 @@ function TBlockSocket.RecvBufferEx(Buffer: Pointer; Length: Integer; var s: string; rl, l: integer; + ti: ULong; begin FLastError := 0; rl := 0; repeat + ti := GetTick; s := RecvPacket(Timeout); l := System.Length(s); if (rl + l) > Length then @@ -689,7 +1082,18 @@ begin rl := rl + l; if FLastError <> 0 then Break; - until rl >= Length; + if rl >= Length then + Break; + if not FInterPacketTimeout then + begin + Timeout := Timeout - integer(TickDelta(ti, GetTick)); + if Timeout <= 0 then + begin + FLastError := WSAETIMEDOUT; + Break; + end; + end; + until False; delete(s, 1, l); FBuffer := s; Result := rl; @@ -724,22 +1128,34 @@ begin end else begin + //not drain CPU on large downloads... Sleep(0); - if CanRead(Timeout) then + x := WaitingData; + if x > 0 then begin - x := WaitingData; - if x = 0 then - FLastError := WSAECONNRESET; - if x > 0 then - begin + SetLength(Result, x); + x := RecvBuffer(Pointer(Result), x); + if x >= 0 then SetLength(Result, x); - x := RecvBuffer(Pointer(Result), x); - if x >= 0 then - SetLength(Result, x); - end; end else - FLastError := WSAETIMEDOUT; + begin + if CanRead(Timeout) then + begin + x := WaitingData; + if x = 0 then + FLastError := WSAECONNRESET; + if x > 0 then + begin + SetLength(Result, x); + x := RecvBuffer(Pointer(Result), x); + if x >= 0 then + SetLength(Result, x); + end; + end + else + FLastError := WSAETIMEDOUT; + end; end; ExceptCheck; end; @@ -767,6 +1183,7 @@ var CorCRLF: Boolean; t: string; tl: integer; + ti: ULong; begin FLastError := 0; Result := ''; @@ -779,6 +1196,7 @@ begin x := 0; repeat //get rest of FBuffer or incomming new data... + ti := GetTick; s := s + RecvPacket(Timeout); if FLastError <> 0 then Break; @@ -810,7 +1228,18 @@ begin FLastError := WSAENOBUFS; Break; end; - until x > 0; + if x > 0 then + Break; + if not FInterPacketTimeout then + begin + Timeout := Timeout - integer(TickDelta(ti, GetTick)); + if Timeout <= 0 then + begin + FLastError := WSAETIMEDOUT; + Break; + end; + end; + until False; if x > 0 then begin Result := Copy(s, 1, x - 1); @@ -832,7 +1261,7 @@ end; function TBlockSocket.PeekBuffer(Buffer: Pointer; Length: Integer): Integer; begin - Result := synsock.Recv(FSocket, Buffer^, Length, MSG_PEEK); + Result := synsock.Recv(FSocket, Buffer^, Length, MSG_PEEK + MSG_NOSIGNAL); SockCheck(Result); ExceptCheck; end; @@ -872,13 +1301,14 @@ var e: ESynapseError; s: string; begin + FLastErrorDesc := ''; if FRaiseExcept and (LastError <> 0) and (LastError <> WSAEINPROGRESS) and (LastError <> WSAEWOULDBLOCK) then begin - s := GetErrorDesc(LastError); - e := ESynapseError.CreateFmt('TCP/IP Socket error %d: %s', [LastError, s]); + FLastErrorDesc := GetErrorDesc(LastError); + e := ESynapseError.CreateFmt('Synapse TCP/IP Socket error %d: %s', [LastError, s]); e.ErrorCode := LastError; - e.ErrorMessage := s; + e.ErrorMessage := FLastErrorDesc; raise e; end; end; @@ -902,35 +1332,22 @@ end; procedure TBlockSocket.SetLinger(Enable: Boolean; Linger: Integer); var - li: TLinger; + d: TSynaOption; begin - li.l_onoff := Ord(Enable); - li.l_linger := Linger div 1000; - SockCheck(synsock.SetSockOpt(FSocket, SOL_SOCKET, SO_LINGER, @li, SizeOf(li))); - ExceptCheck; + d.Option := SOT_Linger; + d.Enabled := Enable; + d.Value := Linger; + DelayedOption(d); end; function TBlockSocket.LocalName: string; var - buf: array[0..255] of Char; - BufPtr: PChar; - RemoteHost: PHostEnt; + s: string; begin - BufPtr := buf; Result := ''; - synsock.GetHostName(BufPtr, SizeOf(buf)); - if BufPtr[0] <> #0 then - begin - // try get Fully Qualified Domain Name - SynSockCS.Enter; - try - RemoteHost := synsock.GetHostByName(BufPtr); - if RemoteHost <> nil then - Result := PChar(RemoteHost^.h_name); - finally - SynSockCS.Leave; - end; - end; + setlength(s, 255); + synsock.GetHostName(pchar(s), Length(s) - 1); + Result := Pchar(s); if Result = '' then Result := '127.0.0.1'; end; @@ -940,6 +1357,12 @@ type TaPInAddr = array[0..250] of PInAddr; PaPInAddr = ^TaPInAddr; var + Hints: TAddrInfo; + Addr: PAddrInfo; + AddrNext: PAddrInfo; + r: integer; + host, serv: string; + hostlen, servlen: integer; RemoteHost: PHostEnt; IP: u_long; PAdrPtr: PaPInAddr; @@ -948,34 +1371,76 @@ var InAddr: TInAddr; begin IPList.Clear; - IP := synsock.inet_addr(PChar(Name)); - if IP = u_long(INADDR_NONE) then + if not IsNewApi then begin - SynSockCS.Enter; - try - RemoteHost := synsock.GetHostByName(PChar(Name)); - if RemoteHost <> nil then - begin - PAdrPtr := PAPInAddr(RemoteHost^.h_addr_list); - i := 0; - while PAdrPtr^[i] <> nil do + IP := synsock.inet_addr(PChar(Name)); + if IP = u_long(INADDR_NONE) then + begin + SynSockCS.Enter; + try + RemoteHost := synsock.GetHostByName(PChar(Name)); + if RemoteHost <> nil then begin - InAddr := PAdrPtr^[i]^; - with InAddr.S_un_b do - s := Format('%d.%d.%d.%d', - [Ord(s_b1), Ord(s_b2), Ord(s_b3), Ord(s_b4)]); - IPList.Add(s); - Inc(i); + PAdrPtr := PAPInAddr(RemoteHost^.h_addr_list); + i := 0; + while PAdrPtr^[i] <> nil do + begin + InAddr := PAdrPtr^[i]^; + with InAddr.S_un_b do + s := Format('%d.%d.%d.%d', + [Ord(s_b1), Ord(s_b2), Ord(s_b3), Ord(s_b4)]); + IPList.Add(s); + Inc(i); + end; end; + finally + SynSockCS.Leave; end; - if IPList.Count = 0 then - IPList.Add('0.0.0.0'); - finally - SynSockCS.Leave; - end; + end + else + IPList.Add(Name); end else - IPList.Add(Name); + begin + Addr := nil; + try + FillChar(Hints, Sizeof(Hints), 0); + Hints.ai_family := AF_UNSPEC; + Hints.ai_socktype := GetSocketType; + Hints.ai_protocol := GetSocketprotocol; + Hints.ai_flags := 0; + r := synsock.GetAddrInfo(PChar(Name), nil, @Hints, Addr); + if r = 0 then + begin + AddrNext := Addr; + while not(AddrNext = nil) do + begin + if not(((FFamily = SF_IP6) and (AddrNext^.ai_family = AF_INET)) + or ((FFamily = SF_IP4) and (AddrNext^.ai_family = AF_INET6))) then + begin + hostlen := NI_MAXHOST; + servlen := NI_MAXSERV; + setlength(host, hostlen); + setlength(serv, servlen); + r := 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 + synsock.FreeAddrInfo(Addr); + end; + end; + if IPList.Count = 0 then + IPList.Add(cAnyHost); end; function TBlockSocket.ResolveName(Name: string): string; @@ -995,19 +1460,105 @@ function TBlockSocket.ResolvePort(Port: string): Word; var ProtoEnt: PProtoEnt; ServEnt: PServEnt; + Hints: TAddrInfo; + Addr: PAddrInfo; + r: integer; begin - SynSockCS.Enter; - try - ProtoEnt := synsock.GetProtoByNumber(FProtocol); - ServEnt := nil; - if ProtoEnt <> nil then - ServEnt := synsock.GetServByName(PChar(Port), ProtoEnt^.p_name); - if ServEnt = nil then - Result := synsock.htons(StrToIntDef(Port, 0)) - else - Result := ServEnt^.s_port; - finally - SynSockCS.Leave; + Result := 0; + if not IsNewApi then + begin + SynSockCS.Enter; + try + ProtoEnt := synsock.GetProtoByNumber(GetSocketProtocol); + ServEnt := nil; + if ProtoEnt <> nil then + ServEnt := synsock.GetServByName(PChar(Port), ProtoEnt^.p_name); + if ServEnt = nil then + Result := synsock.htons(StrToIntDef(Port, 0)) + else + Result := ServEnt^.s_port; + finally + SynSockCS.Leave; + end; + end + else + begin + Addr := nil; + try + FillChar(Hints, Sizeof(Hints), 0); + Hints.ai_family := AF_UNSPEC; + Hints.ai_socktype := GetSocketType; + Hints.ai_protocol := GetSocketprotocol; + Hints.ai_flags := AI_PASSIVE; + r := synsock.GetAddrInfo(nil, PChar(Port), @Hints, Addr); + if r = 0 then + begin + if Addr^.ai_family = AF_INET then + Result := synsock.htons(Addr^.ai_addr^.sin_port); + if Addr^.ai_family = AF_INET6 then + Result := synsock.htons(PSockAddrIn6(Addr^.ai_addr)^.sin6_port); + end; + finally + if Assigned(Addr) then + synsock.FreeAddrInfo(Addr); + end; + end; +end; + +function TBlockSocket.ResolveIPToName(IP: string): string; +var + Hints: TAddrInfo; + Addr: PAddrInfo; + r: integer; + host, serv: string; + hostlen, servlen: integer; + RemoteHost: PHostEnt; + IPn: u_long; +begin + Result := IP; + if not IsNewApi then + begin + if not IsIP(IP) then + IP := ResolveName(IP); + IPn := synsock.inet_addr(PChar(IP)); + if IPn <> u_long(INADDR_NONE) then + begin + SynSockCS.Enter; + try + RemoteHost := GetHostByAddr(@IPn, SizeOf(IPn), AF_INET); + if RemoteHost <> nil then + Result := RemoteHost^.h_name; + finally + SynSockCS.Leave; + end; + end; + end + else + begin + Addr := nil; + try + FillChar(Hints, Sizeof(Hints), 0); + Hints.ai_family := AF_UNSPEC; + Hints.ai_socktype := GetSocketType; + Hints.ai_protocol := GetSocketprotocol; + Hints.ai_flags := 0; + r := synsock.GetAddrInfo(PChar(IP), nil, @Hints, Addr); + if r = 0 then + begin + hostlen := NI_MAXHOST; + servlen := NI_MAXSERV; + setlength(host, hostlen); + setlength(serv, servlen); + r := getnameinfo(Addr^.ai_addr, Addr^.ai_addrlen, + PChar(host), hostlen, PChar(serv), servlen, + NI_NUMERICSERV); + if r = 0 then + Result := PChar(host); + end; + finally + if Assigned(Addr) then + synsock.FreeAddrInfo(Addr); + end; end; end; @@ -1038,18 +1589,17 @@ end; function TBlockSocket.CanRead(Timeout: Integer): Boolean; var - FDSet: TFDSet; TimeVal: PTimeVal; TimeV: TTimeVal; x: Integer; + FDSet: TFDSet; begin TimeV.tv_usec := (Timeout mod 1000) * 1000; TimeV.tv_sec := Timeout div 1000; TimeVal := @TimeV; if Timeout = -1 then TimeVal := nil; - FD_ZERO(FDSet); - FD_SET(FSocket, FDSet); + FDSet := FFdSet; x := synsock.Select(FSocket + 1, @FDSet, nil, nil, TimeVal); SockCheck(x); if FLastError <> 0 then @@ -1062,18 +1612,17 @@ end; function TBlockSocket.CanWrite(Timeout: Integer): Boolean; var - FDSet: TFDSet; TimeVal: PTimeVal; TimeV: TTimeVal; x: Integer; + FDSet: TFDSet; begin TimeV.tv_usec := (Timeout mod 1000) * 1000; TimeV.tv_sec := Timeout div 1000; TimeVal := @TimeV; if Timeout = -1 then TimeVal := nil; - FD_ZERO(FDSet); - FD_SET(FSocket, FDSet); + FDSet := FFdSet; x := synsock.Select(FSocket + 1, nil, @FDSet, nil, TimeVal); SockCheck(x); if FLastError <> 0 then @@ -1097,8 +1646,16 @@ var Len: Integer; begin LimitBandwidth(Length, FMaxSendBandwidth, FNextsend); - Len := SizeOf(FRemoteSin); - Result := synsock.SendTo(FSocket, Buffer^, Length, 0, FRemoteSin, Len); + if FIP6Used then + begin + Len := SizeOf(FRemoteSin.ip6); + Result := synsock.SendTo(FSocket, Buffer^, Length, 0, @FRemoteSin.ip6, Len); + end + else + begin + Len := SizeOf(FRemoteSin.ip4); + Result := synsock.SendTo(FSocket, Buffer^, Length, 0, @FRemoteSin.ip4, Len); + end; SockCheck(Result); ExceptCheck; DoStatus(HR_WriteCount, IntToStr(Result)); @@ -1109,8 +1666,16 @@ var Len: Integer; begin LimitBandwidth(Length, FMaxRecvBandwidth, FNextRecv); - Len := SizeOf(FRemoteSin); - Result := synsock.RecvFrom(FSocket, Buffer^, Length, 0, FRemoteSin, Len); + if FIP6Used then + begin + Len := SizeOf(FRemoteSin.ip6); + Result := synsock.RecvFrom(FSocket, Buffer^, Length, 0, @FRemoteSin.ip6, Len); + end + else + begin + Len := SizeOf(FRemoteSin.ip4); + Result := synsock.RecvFrom(FSocket, Buffer^, Length, 0, @FRemoteSin.ip4, Len); + end; SockCheck(Result); ExceptCheck; DoStatus(HR_ReadCount, IntToStr(Result)); @@ -1128,9 +1693,12 @@ begin end; procedure TBlockSocket.SetSizeRecvBuffer(Size: Integer); +var + d: TSynaOption; begin - SockCheck(synsock.SetSockOpt(FSocket, SOL_SOCKET, SO_RCVBUF, @Size, SizeOf(Size))); - ExceptCheck; + d.Option := SOT_RecvBuff; + d.Value := Size; + DelayedOption(d); end; function TBlockSocket.GetSizeSendBuffer: Integer; @@ -1145,41 +1713,45 @@ begin end; procedure TBlockSocket.SetSizeSendBuffer(Size: Integer); +var + d: TSynaOption; begin - SockCheck(synsock.SetSockOpt(FSocket, SOL_SOCKET, SO_SNDBUF, @Size, SizeOf(Size))); - ExceptCheck; + d.Option := SOT_SendBuff; + d.Value := Size; + DelayedOption(d); end; procedure TBlockSocket.SetNonBlockMode(Value: Boolean); var - x: integer; + d: TSynaOption; begin - FNonBlockMode := Value; - if Value then - x := 1 - else - x := 0; - synsock.IoctlSocket(FSocket, FIONBIO, u_long(x)); + d.Option := SOT_nonblock; + d.Enabled := Value; + DelayedOption(d); end; -//See 'winsock2.txt' file in distribute package! -function TBlockSocket.SetTimeout(Timeout: Integer): Boolean; +procedure TBlockSocket.SetTimeout(Timeout: Integer); begin - Result := SetSendTimeout(Timeout) and SetRecvTimeout(Timeout); + SetSendTimeout(Timeout); + SetRecvTimeout(Timeout); end; -//See 'winsock2.txt' file in distribute package! -function TBlockSocket.SetSendTimeout(Timeout: Integer): Boolean; +procedure TBlockSocket.SetSendTimeout(Timeout: Integer); +var + d: TSynaOption; begin - Result := synsock.SetSockOpt(FSocket, SOL_SOCKET, SO_SNDTIMEO, - @Timeout, SizeOf(Timeout)) <> SOCKET_ERROR; + d.Option := SOT_sendtimeout; + d.Value := Timeout; + DelayedOption(d); end; -//See 'winsock2.txt' file in distribute package! -function TBlockSocket.SetRecvTimeout(Timeout: Integer): Boolean; +procedure TBlockSocket.SetRecvTimeout(Timeout: Integer); +var + d: TSynaOption; begin - Result := synsock.SetSockOpt(FSocket, SOL_SOCKET, SO_RCVTIMEO, - @Timeout, SizeOf(Timeout)) <> SOCKET_ERROR; + d.Option := SOT_recvtimeout; + d.Value := Timeout; + DelayedOption(d); end; function TBlockSocket.GroupCanRead(const SocketList: TList; Timeout: Integer; @@ -1219,25 +1791,22 @@ begin CanReadList.Add(TBlockSocket(SocketList.Items[n])); end; -function TBlockSocket.EnableReuse(Value: Boolean): Boolean; +procedure TBlockSocket.EnableReuse(Value: Boolean); var - Opt: Integer; - Res: Integer; + d: TSynaOption; begin - opt := Ord(Value); - Res := synsock.SetSockOpt(FSocket, SOL_SOCKET, SO_REUSEADDR, @Opt, SizeOf(opt)); - SockCheck(Res); - Result := res = 0; - ExceptCheck; + d.Option := SOT_reuse; + d.Enabled := Value; + DelayedOption(d); end; procedure TBlockSocket.SetTTL(TTL: integer); var - Res: Integer; + d: TSynaOption; begin - Res := synsock.SetSockOpt(FSocket, IPPROTO_IP, IP_TTL, @TTL, SizeOf(TTL)); - SockCheck(Res); - ExceptCheck; + d.Option := SOT_TTL; + d.Value := TTL; + DelayedOption(d); end; function TBlockSocket.GetTTL:integer; @@ -1245,8 +1814,79 @@ var l: Integer; begin l := SizeOf(Result); - SockCheck(synsock.GetSockOpt(FSocket, IPPROTO_IP, IP_TTL, @Result, l)); - ExceptCheck; + if FIP6Used then + synsock.GetSockOpt(FSocket, IPPROTO_IPV6, IPV6_UNICAST_HOPS, @Result, l) + else + synsock.GetSockOpt(FSocket, IPPROTO_IP, IP_TTL, @Result, l); +end; + +procedure TBlockSocket.SetFamily(Value: TSocketFamily); +begin + FFamily := Value; + FFamilySave := Value; +end; + +procedure TBlockSocket.SetSocket(Value: TSocket); +begin + FSocket := Value; + FD_ZERO(FFDSet); + FD_SET(FSocket, FFDSet); + GetSins; +end; + +function TBlockSocket.StrToIP6(const value: string): TSockAddrIn6; +var + addr: PAddrInfo; + hints: TAddrInfo; + r: integer; +begin + FillChar(Result, Sizeof(Result), 0); + if SockEnhancedApi or SockWship6Api then + begin + Addr := nil; + try + FillChar(Hints, Sizeof(Hints), 0); + Hints.ai_family := AF_INET6; + Hints.ai_flags := AI_NUMERICHOST; + r := synsock.GetAddrInfo(PChar(value), nil, @Hints, Addr); + if r = 0 then + if (Addr^.ai_family = AF_INET6) then + Move(Addr^.ai_addr^, Result, SizeOf(Result)); + finally + if Assigned(Addr) then + synsock.FreeAddrInfo(Addr); + end; + end; +end; + +function TBlockSocket.IP6ToStr(const value: TSockAddrIn6): string; +var + host, serv: string; + hostlen, servlen: integer; + r: integer; +begin + Result := ''; + if SockEnhancedApi or SockWship6Api then + begin + hostlen := NI_MAXHOST; + servlen := NI_MAXSERV; + setlength(host, hostlen); + setlength(serv, servlen); + r := getnameinfo(@Value, SizeOf(value), PChar(host), hostlen, + PChar(serv), servlen, NI_NUMERICHOST + NI_NUMERICSERV); + if r = 0 then + Result := PChar(host); + end; +end; + +function TBlockSocket.GetSocketType: integer; +begin + Result := 0; +end; + +function TBlockSocket.GetSocketProtocol: integer; +begin + Result := IPPROTO_IP end; procedure TBlockSocket.DoStatus(Reason: THookSocketReason; const Value: string); @@ -1289,6 +1929,12 @@ begin end; end; +procedure TBlockSocket.DoCreateSocket; +begin + if assigned(OnCreateSocket) then + OnCreateSocket(Self); +end; + class function TBlockSocket.GetErrorDesc(ErrorCode: Integer): string; begin case ErrorCode of @@ -1421,6 +2067,7 @@ begin FSocksRemoteIP := ''; FSocksRemotePort := ''; FBypassFlag := False; + FSocksType := ST_Socks5; end; function TSocksBlockSocket.SocksOpen: boolean; @@ -1430,40 +2077,49 @@ var begin Result := False; FUsingSocks := False; - FBypassFlag := True; - try - if FSocksUsername = '' then - Buf := #5 + #1 + #0 - else - Buf := #5 + #2 + #2 +#0; - SendString(Buf); - Buf := RecvBufferStr(2, FSocksTimeout); - if Length(Buf) < 2 then - Exit; - if Buf[1] <> #5 then - Exit; - n := Ord(Buf[2]); - case n of - 0: //not need authorisation - ; - 2: - begin - Buf := #1 + char(Length(FSocksUsername)) + FSocksUsername - + char(Length(FSocksPassword)) + FSocksPassword; - SendString(Buf); - Buf := RecvBufferStr(2, FSocksTimeout); - if Length(Buf) < 2 then - Exit; - if Buf[2] <> #0 then - Exit; - end; - else - Exit; - end; + if FSocksType <> ST_Socks5 then + begin FUsingSocks := True; Result := True; - finally - FBypassFlag := False; + end + else + begin + FBypassFlag := True; + try + if FSocksUsername = '' then + Buf := #5 + #1 + #0 + else + Buf := #5 + #2 + #2 +#0; + SendString(Buf); + Buf := RecvBufferStr(2, FSocksTimeout); + if Length(Buf) < 2 then + Exit; + if Buf[1] <> #5 then + Exit; + n := Ord(Buf[2]); + case n of + 0: //not need authorisation + ; + 2: + begin + Buf := #1 + char(Length(FSocksUsername)) + FSocksUsername + + char(Length(FSocksPassword)) + FSocksPassword; + SendString(Buf); + Buf := RecvBufferStr(2, FSocksTimeout); + if Length(Buf) < 2 then + Exit; + if Buf[2] <> #0 then + Exit; + end; + else + //other authorisation is not supported! + Exit; + end; + FUsingSocks := True; + Result := True; + finally + FBypassFlag := False; + end; end; end; @@ -1474,7 +2130,10 @@ var begin FBypassFlag := True; try - Buf := #5 + char(Cmd) + #0 + SocksCode(IP, Port); + if FSocksType <> ST_Socks5 then + Buf := #4 + char(Cmd) + SocksCode(IP, Port) + else + Buf := #5 + char(Cmd) + #0 + SocksCode(IP, Port); SendString(Buf); Result := FLastError = 0; finally @@ -1492,30 +2151,43 @@ begin try FSocksResponseIP := ''; FSocksResponsePort := ''; - - Buf := RecvBufferStr(4, FSocksTimeout); - if FLastError <> 0 then - Exit; - if Buf[1] <> #5 then - Exit; - case Ord(Buf[4]) of - 1: - s := RecvBufferStr(4, FSocksTimeout); - 3: - begin - x := RecvByte(FSocksTimeout); - if FLastError <> 0 then - Exit; - s := char(x) + RecvBufferStr(x, FSocksTimeout); - end; + FSocksLastError := -1; + if FSocksType <> ST_Socks5 then + begin + Buf := RecvBufferStr(8, FSocksTimeout); + if FLastError <> 0 then + Exit; + if Buf[1] <> #4 then + Exit; + FSocksLastError := Ord(Buf[2]); + end else - Exit; + begin + Buf := RecvBufferStr(4, FSocksTimeout); + if FLastError <> 0 then + Exit; + if Buf[1] <> #5 then + Exit; + case Ord(Buf[4]) of + 1: + s := RecvBufferStr(4, FSocksTimeout); + 3: + begin + x := RecvByte(FSocksTimeout); + if FLastError <> 0 then + Exit; + s := char(x) + RecvBufferStr(x, FSocksTimeout); + end; + 4: + s := RecvBufferStr(16, FSocksTimeout); + else + Exit; + end; + Buf := Buf + s + RecvBufferStr(2, FSocksTimeout); + if FLastError <> 0 then + Exit; + FSocksLastError := Ord(Buf[2]); end; - Buf := Buf + s + RecvBufferStr(2, FSocksTimeout); - if FLastError <> 0 then - Exit; - - FSocksLastError := Ord(Buf[2]); if FSocksLastError <> 0 then Exit; SocksDecode(Buf); @@ -1526,15 +2198,60 @@ begin end; function TSocksBlockSocket.SocksCode(IP, Port: string): string; +var + s: string; + ip6: TSockAddrIn6; begin - if IsIP(IP) then - Result := #1 + IPToID(IP) - else - if FSocksResolver then - Result := #3 + char(Length(IP)) + IP + if FSocksType <> ST_Socks5 then + begin + Result := CodeInt(ResolvePort(Port)); + if not FSocksResolver then + IP := ResolveName(IP); + if IsIP(IP) then + begin + Result := Result + IPToID(IP); + Result := Result + FSocksUsername + #0; + end else - Result := #1 + IPToID(ResolveName(IP)); - Result := Result + CodeInt(synsock.htons(ResolvePort(Port))); + begin + Result := Result + IPToID('0.0.0.1'); + Result := Result + FSocksUsername + #0; + Result := Result + IP + #0; + end; + end + else + begin + if not FSocksResolver then + IP := ResolveName(IP); + if IsIP(IP) then + Result := #1 + IPToID(IP) + else + if IsIP6(IP) then + begin + ip6 := StrToIP6(IP); + setlength(s, 16); + s[1] := ip6.sin6_addr.S_un_b.s_b1; + s[2] := ip6.sin6_addr.S_un_b.s_b2; + s[3] := ip6.sin6_addr.S_un_b.s_b3; + s[4] := ip6.sin6_addr.S_un_b.s_b4; + s[5] := ip6.sin6_addr.S_un_b.s_b5; + s[6] := ip6.sin6_addr.S_un_b.s_b6; + s[7] := ip6.sin6_addr.S_un_b.s_b7; + s[8] := ip6.sin6_addr.S_un_b.s_b8; + s[9] := ip6.sin6_addr.S_un_b.s_b9; + s[10] := ip6.sin6_addr.S_un_b.s_b10; + s[11] := ip6.sin6_addr.S_un_b.s_b11; + s[12] := ip6.sin6_addr.S_un_b.s_b12; + s[13] := ip6.sin6_addr.S_un_b.s_b13; + s[14] := ip6.sin6_addr.S_un_b.s_b14; + s[15] := ip6.sin6_addr.S_un_b.s_b15; + s[16] := ip6.sin6_addr.S_un_b.s_b16; + Result := #4 + s; + end + else + Result := #3 + char(Length(IP)) + IP; + Result := Result + CodeInt(ResolvePort(Port)); + end; end; function TSocksBlockSocket.SocksDecode(Value: string): integer; @@ -1542,36 +2259,77 @@ var Atyp: Byte; y, n: integer; w: Word; + ip6: TSockAddrIn6; begin FSocksResponsePort := '0'; - if Length(Value) < 4 then - Exit; - Atyp := Ord(Value[4]); - Result := 5; - case Atyp of - 1: - begin - if Length(Value) < 10 then - Exit; - FSocksResponseIP := Format('%d.%d.%d.%d', - [Ord(Value[5]), Ord(Value[6]), Ord(Value[7]), Ord(Value[8])]); - Result := 9; - end; - 3: - begin - y := Ord(Value[5]); - if Length(Value) < (5 + y + 2) then - Exit; - for n := 6 to 6 + y - 1 do - FSocksResponseIP := FSocksResponseIP + Value[n]; - Result := 5 + y + 1; - end; + Result := 0; + if FSocksType <> ST_Socks5 then + begin + if Length(Value) < 8 then + Exit; + Result := 3; + w := DecodeInt(Value, Result); + FSocksResponsePort := IntToStr(w); + FSocksResponseIP := Format('%d.%d.%d.%d', + [Ord(Value[5]), Ord(Value[6]), Ord(Value[7]), Ord(Value[8])]); + Result := 9; + end else - Exit; + begin + if Length(Value) < 4 then + Exit; + Atyp := Ord(Value[4]); + Result := 5; + case Atyp of + 1: + begin + if Length(Value) < 10 then + Exit; + FSocksResponseIP := Format('%d.%d.%d.%d', + [Ord(Value[5]), Ord(Value[6]), Ord(Value[7]), Ord(Value[8])]); + Result := 9; + end; + 3: + begin + y := Ord(Value[5]); + if Length(Value) < (5 + y + 2) then + Exit; + for n := 6 to 6 + y - 1 do + FSocksResponseIP := FSocksResponseIP + Value[n]; + Result := 5 + y + 1; + end; + 4: + begin + if Length(Value) < 22 then + Exit; + FillChar(ip6, SizeOf(ip6), 0); + ip6.sin6_addr.S_un_b.s_b1 := Value[5]; + ip6.sin6_addr.S_un_b.s_b2 := Value[6]; + ip6.sin6_addr.S_un_b.s_b3 := Value[7]; + ip6.sin6_addr.S_un_b.s_b4 := Value[8]; + ip6.sin6_addr.S_un_b.s_b5 := Value[9]; + ip6.sin6_addr.S_un_b.s_b6 := Value[10]; + ip6.sin6_addr.S_un_b.s_b7 := Value[11]; + ip6.sin6_addr.S_un_b.s_b8 := Value[12]; + ip6.sin6_addr.S_un_b.s_b9 := Value[13]; + ip6.sin6_addr.S_un_b.s_b10 := Value[14]; + ip6.sin6_addr.S_un_b.s_b11 := Value[15]; + ip6.sin6_addr.S_un_b.s_b12 := Value[16]; + ip6.sin6_addr.S_un_b.s_b13 := Value[17]; + ip6.sin6_addr.S_un_b.s_b14 := Value[18]; + ip6.sin6_addr.S_un_b.s_b15 := Value[19]; + ip6.sin6_addr.S_un_b.s_b16 := Value[20]; + ip6.sin6_family := AF_INET6; + FSocksResponseIP := IP6ToStr(ip6); + Result := 21; + end; + else + Exit; + end; + w := DecodeInt(Value, Result); + FSocksResponsePort := IntToStr(w); + Result := Result + 2; end; - w := DecodeInt(Value, Result); - FSocksResponsePort := IntToStr(w); - Result := Result + 2; end; {======================================================================} @@ -1583,29 +2341,19 @@ begin inherited; end; -procedure TUDPBlockSocket.CreateSocket; -begin - FSocket := synsock.Socket(PF_INET, Integer(SOCK_DGRAM), IPPROTO_UDP); - FProtocol := IPPROTO_UDP; - inherited CreateSocket; -end; - -function TUDPBlockSocket.EnableBroadcast(Value: Boolean): Boolean; +procedure TUDPBlockSocket.EnableBroadcast(Value: Boolean); var - Opt: Integer; - Res: Integer; + d: TSynaOption; begin - opt := Ord(Value); - Res := synsock.SetSockOpt(FSocket, SOL_SOCKET, SO_BROADCAST, @Opt, SizeOf(opt)); - SockCheck(Res); - Result := res = 0; - ExceptCheck; + d.Option := SOT_Broadcast; + d.Enabled := Value; + DelayedOption(d); end; procedure TUDPBlockSocket.Connect(IP, Port: string); begin - AutoCreateSocket; SetRemoteSin(IP, Port); + InternalCreateSocket(FRemoteSin); FBuffer := ''; DoStatus(HR_Connect, IP + ':' + Port); end; @@ -1632,13 +2380,13 @@ begin if not Assigned(FSocksControlSock) then FSocksControlSock := TTCPBlockSocket.Create; FSocksControlSock.CloseSocket; - FSocksControlSock.CreateSocket; + FSocksControlSock.CreateSocketByName(FSocksIP); FSocksControlSock.Connect(FSocksIP, FSocksPort); if FSocksControlSock.LastError <> 0 then Exit; // if not assigned local port, assign it! if not FBinded then - Bind('0.0.0.0', '0'); + Bind(cAnyHost, cAnyPort); //open control TCP connection to SOCKS b := FSocksControlSock.SocksOpen; if b then @@ -1660,6 +2408,7 @@ var SPort: integer; Buf: string; begin + Result := 0; FUsingSocks := False; if (FSocksIP <> '') and (not UdpAssociation) then FLastError := WSANO_RECOVERY @@ -1704,33 +2453,55 @@ end; procedure TUDPBlockSocket.AddMulticast(MCastIP: string); var - Multicast: TMulticast; + Multicast: TIP_mreq; + Multicast6: TIPv6_mreq; begin - Multicast.MCastAddr := synsock.inet_addr(PChar(MCastIP)); - Multicast.MCastIfc := u_long(INADDR_ANY); - SockCheck(synsock.SetSockOpt(FSocket, IPPROTO_IP, IP_ADD_MEMBERSHIP, - pchar(@Multicast), SizeOf(Multicast))); + if FIP6Used then + begin + Multicast6.ipv6mr_multiaddr := StrToIp6(MCastIP).sin6_addr; + Multicast6.ipv6mr_interface := 0; + SockCheck(synsock.SetSockOpt(FSocket, IPPROTO_IPV6, IPV6_JOIN_GROUP, + pchar(@Multicast6), SizeOf(Multicast6))); + end + else + begin + Multicast.imr_multiaddr.S_addr := synsock.inet_addr(PChar(MCastIP)); + Multicast.imr_interface.S_addr := u_long(INADDR_ANY); + SockCheck(synsock.SetSockOpt(FSocket, IPPROTO_IP, IP_ADD_MEMBERSHIP, + pchar(@Multicast), SizeOf(Multicast))); + end; ExceptCheck; end; procedure TUDPBlockSocket.DropMulticast(MCastIP: string); var - Multicast: TMulticast; + Multicast: TIP_mreq; + Multicast6: TIPv6_mreq; begin - Multicast.MCastAddr := synsock.inet_addr(PChar(MCastIP)); - Multicast.MCastIfc := u_long(INADDR_ANY); - SockCheck(synsock.SetSockOpt(FSocket, IPPROTO_IP, IP_DROP_MEMBERSHIP, - pchar(@Multicast), SizeOf(Multicast))); + if FIP6Used then + begin + Multicast6.ipv6mr_multiaddr := StrToIp6(MCastIP).sin6_addr; + Multicast6.ipv6mr_interface := 0; + SockCheck(synsock.SetSockOpt(FSocket, IPPROTO_IPV6, IPV6_LEAVE_GROUP, + pchar(@Multicast6), SizeOf(Multicast6))); + end + else + begin + Multicast.imr_multiaddr.S_addr := synsock.inet_addr(PChar(MCastIP)); + Multicast.imr_interface.S_addr := u_long(INADDR_ANY); + SockCheck(synsock.SetSockOpt(FSocket, IPPROTO_IP, IP_DROP_MEMBERSHIP, + pchar(@Multicast), SizeOf(Multicast))); + end; ExceptCheck; end; procedure TUDPBlockSocket.SetMulticastTTL(TTL: integer); var - Res: Integer; + d: TSynaOption; begin - Res := synsock.SetSockOpt(FSocket, IPPROTO_IP, IP_MULTICAST_TTL, @TTL, SizeOf(TTL)); - SockCheck(Res); - ExceptCheck; + d.Option := SOT_MulticastTTL; + d.Value := TTL; + DelayedOption(d); end; function TUDPBlockSocket.GetMulticastTTL:integer; @@ -1738,20 +2509,29 @@ var l: Integer; begin l := SizeOf(Result); - SockCheck(synsock.GetSockOpt(FSocket, IPPROTO_IP, IP_MULTICAST_TTL, @Result, l)); - ExceptCheck; + if FIP6Used then + synsock.GetSockOpt(FSocket, IPPROTO_IPV6, IPV6_MULTICAST_HOPS, @Result, l) + else + synsock.GetSockOpt(FSocket, IPPROTO_IP, IP_MULTICAST_TTL, @Result, l); end; -function TUDPBlockSocket.EnableMulticastLoop(Value: Boolean): Boolean; +procedure TUDPBlockSocket.EnableMulticastLoop(Value: Boolean); var - Opt: Integer; - Res: Integer; + d: TSynaOption; begin - opt := Ord(Value); - Res := synsock.SetSockOpt(FSocket, IPPROTO_IP, IP_MULTICAST_LOOP, @Opt, SizeOf(opt)); - SockCheck(Res); - Result := res = 0; - ExceptCheck; + d.Option := SOT_MulticastLoop; + d.Enabled := Value; + DelayedOption(d); +end; + +function TUDPBlockSocket.GetSocketType: integer; +begin + Result := SOCK_DGRAM; +end; + +function TUDPBlockSocket.GetSocketProtocol: integer; +begin + Result := IPPROTO_UDP; end; {======================================================================} @@ -1792,24 +2572,17 @@ begin FHTTPTunnelPass := ''; end; -destructor TTCPBlockSocket.Destroy; -begin - if FSslEnabled then - SslEnabled := False; - inherited; -end; - -procedure TTCPBlockSocket.CreateSocket; -begin - FSocket := synsock.Socket(PF_INET, Integer(SOCK_STREAM), IPPROTO_TCP); - FProtocol := IPPROTO_TCP; - inherited CreateSocket; -end; - procedure TTCPBlockSocket.CloseSocket; begin + if SSLEnabled then + SSLDoShutdown; if FSocket <> INVALID_SOCKET then - synsock.Shutdown(FSocket, 1); + begin + Synsock.Shutdown(FSocket, 1); + repeat + RecvPacket(0); + until FLastError <> 0; + end; inherited CloseSocket; end; @@ -1835,7 +2608,7 @@ begin else begin Sip := GetLocalSinIP; - if Sip = '0.0.0.0' then + if Sip = cAnyHost then Sip := LocalName; SPort := IntToStr(GetLocalSinPort); inherited Connect(FSocksIP, FSocksPort); @@ -1847,7 +2620,7 @@ begin if not b and (FLastError = 0) then FLastError := WSANO_RECOVERY; FSocksLocalIP := FSocksResponseIP; - if FSocksLocalIP = '0.0.0.0' then + if FSocksLocalIP = cAnyHost then FSocksLocalIP := FSocksIP; FSocksLocalPort := FSocksResponsePort; FSocksRemoteIP := ''; @@ -1871,8 +2644,16 @@ begin end else begin - Len := SizeOf(FRemoteSin); - Result := synsock.Accept(FSocket, @FRemoteSin, @Len); + if FIP6used then + begin + Len := SizeOf(FRemoteSin.ip6); + Result := synsock.Accept(FSocket, @FRemoteSin.ip6, Len); + end + else + begin + Len := SizeOf(FRemoteSin.ip4); + Result := synsock.Accept(FSocket, @FRemoteSin.ip4, Len); + end; SockCheck(Result); end; ExceptCheck; @@ -1881,7 +2662,6 @@ end; procedure TTCPBlockSocket.Connect(IP, Port: string); begin - AutoCreateSocket; if FSocksIP <> '' then SocksDoConnect(IP, Port) else @@ -1922,11 +2702,14 @@ var s: string; begin try + Port := IntToStr(ResolvePort(Port)); FBypassFlag := True; inherited Connect(FHTTPTunnelIP, FHTTPTunnelPort); if FLastError <> 0 then Exit; FHTTPTunnel := False; + if IsIP6(IP) then + IP := '[' + IP + ']'; SendString('CONNECT ' + IP + ':' + Port + ' HTTP/1.0' + CRLF); if FHTTPTunnelUser <> '' then Sendstring('Proxy-Authorization: Basic ' + @@ -1971,8 +2754,8 @@ begin FLastError := 0; if sslshutdown(FSsl) < 0 then FLastError := WSASYSNOTREADY; - ExceptCheck; SSLEnabled := False; + ExceptCheck; end; function TTCPBlockSocket.GetLocalSinIP: string; @@ -2005,7 +2788,7 @@ end; function TTCPBlockSocket.GetRemoteSinPort: Integer; begin if FUsingSocks then - Result := StrToIntDef(FSocksRemotePort, 0) + Result := ResolvePort(FSocksRemotePort) else if FHTTPTunnel then Result := StrToIntDef(FHTTPTunnelRemotePort, 0) @@ -2246,26 +3029,41 @@ begin SslX509Free(cert); end; -{======================================================================} - -//See 'winsock2.txt' file in distribute package! - -procedure TICMPBlockSocket.CreateSocket; +function TTCPBlockSocket.GetSocketType: integer; begin - FSocket := synsock.Socket(PF_INET, Integer(SOCK_RAW), IPPROTO_ICMP); - FProtocol := IPPROTO_ICMP; - inherited CreateSocket; + Result := SOCK_STREAM; +end; + +function TTCPBlockSocket.GetSocketProtocol: integer; +begin + Result := IPPROTO_TCP; end; {======================================================================} -//See 'winsock2.txt' file in distribute package! - -procedure TRAWBlockSocket.CreateSocket; +function TICMPBlockSocket.GetSocketType: integer; begin - FSocket := synsock.Socket(PF_INET, Integer(SOCK_RAW), IPPROTO_RAW); - FProtocol := IPPROTO_RAW; - inherited CreateSocket; + Result := SOCK_RAW; +end; + +function TICMPBlockSocket.GetSocketProtocol: integer; +begin + if FIP6Used then + Result := IPPROTO_ICMPV6 + else + Result := IPPROTO_ICMP; +end; + +{======================================================================} + +function TRAWBlockSocket.GetSocketType: integer; +begin + Result := SOCK_RAW; +end; + +function TRAWBlockSocket.GetSocketProtocol: integer; +begin + Result := IPPROTO_RAW; end; {======================================================================} @@ -2284,14 +3082,14 @@ end; {$IFDEF ONCEWINSOCK} initialization begin - if not InitSocketInterface('') then + if not InitSocketInterface(DLLStackName) then begin - e := ESynapseError.Create('Error loading Winsock DLL!'); + e := ESynapseError.Create('Error loading Socket interface (' + DLLStackName + ')!'); e.ErrorCode := 0; - e.ErrorMessage := 'Error loading Winsock DLL!'; + e.ErrorMessage := 'Error loading Socket interface (' + DLLStackName + ')!'; raise e; end; - synsock.WSAStartup($101, WsaDataOnce); + synsock.WSAStartup(WinsockLevel, WsaDataOnce); end; finalization diff --git a/dnssend.pas b/dnssend.pas index 4411464..79d1a95 100644 --- a/dnssend.pas +++ b/dnssend.pas @@ -1,5 +1,5 @@ {==============================================================================| -| Project : Delphree - Synapse | 002.001.001 | +| Project : Delphree - Synapse | 002.002.002 | |==============================================================================| | Content: DNS client | |==============================================================================| @@ -45,7 +45,6 @@ // RFC-1035, RFC-1183, RFC1706, RFC1712, RFC2163, RFC2230 {$Q-} -{$WEAKPACKAGEUNIT ON} unit DNSsend; @@ -53,7 +52,7 @@ interface uses SysUtils, Classes, - blcksock, SynaUtil; + blcksock, SynaUtil, synsock; const cDnsProtocol = 'domain'; @@ -86,7 +85,7 @@ const QTYPE_KEY = 25; // RFC-2065 QTYPE_PX = 26; QTYPE_GPOS = 27; - QTYPE_AAAA = 28; // IP6 Address [Susan Thomson] + QTYPE_AAAA = 28; QTYPE_LOC = 29; // RFC-1876 QTYPE_NXT = 30; // RFC-2065 @@ -112,6 +111,8 @@ type FNameserverInfo: TStringList; FAdditionalInfo: TStringList; FAuthoritative: Boolean; + function ReverseIP(Value: string): string; + function ReverseIP6(Value: string): string; function CompressName(const Value: string): string; function CodeHeader: string; function CodeQuery(const Name: string; QType: Integer): string; @@ -167,6 +168,44 @@ begin inherited Destroy; end; +function TDNSSend.ReverseIP(Value: string): string; +var + x: Integer; +begin + Result := ''; + repeat + x := LastDelimiter('.', Value); + Result := Result + '.' + Copy(Value, x + 1, Length(Value) - x); + Delete(Value, x, Length(Value) - x + 1); + until x < 1; + if Length(Result) > 0 then + if Result[1] = '.' then + Delete(Result, 1, 1); +end; + +function TDNSSend.ReverseIP6(Value: string): string; +var + ip6: TSockAddrIn6; +begin + ip6 := FSock.StrToIP6(Value); + Result := ip6.sin6_addr.S_un_b.s_b16 + + '.' + ip6.sin6_addr.S_un_b.s_b15 + + '.' + ip6.sin6_addr.S_un_b.s_b14 + + '.' + ip6.sin6_addr.S_un_b.s_b13 + + '.' + ip6.sin6_addr.S_un_b.s_b12 + + '.' + ip6.sin6_addr.S_un_b.s_b11 + + '.' + ip6.sin6_addr.S_un_b.s_b10 + + '.' + ip6.sin6_addr.S_un_b.s_b9 + + '.' + ip6.sin6_addr.S_un_b.s_b8 + + '.' + ip6.sin6_addr.S_un_b.s_b7 + + '.' + ip6.sin6_addr.S_un_b.s_b6 + + '.' + ip6.sin6_addr.S_un_b.s_b5 + + '.' + ip6.sin6_addr.S_un_b.s_b4 + + '.' + ip6.sin6_addr.S_un_b.s_b3 + + '.' + ip6.sin6_addr.S_un_b.s_b2 + + '.' + ip6.sin6_addr.S_un_b.s_b1; +end; + function TDNSSend.CompressName(const Value: string): string; var n: Integer; @@ -258,6 +297,7 @@ var RType, Len, j, x, n: Integer; R: string; t1, t2, ttl: integer; + ip6: TSockAddrIn6; begin Result := ''; R := ''; @@ -273,72 +313,95 @@ begin Inc(i, 2); // i point to begin of data j := i; i := i + len; // i point to next record - case RType of - QTYPE_A: - begin - R := IntToStr(Ord(FBuffer[j])); - Inc(j); - R := R + '.' + IntToStr(Ord(FBuffer[j])); - Inc(j); - R := R + '.' + IntToStr(Ord(FBuffer[j])); - Inc(j); - R := R + '.' + IntToStr(Ord(FBuffer[j])); - end; - QTYPE_NS, QTYPE_MD, QTYPE_MF, QTYPE_CNAME, QTYPE_MB, - QTYPE_MG, QTYPE_MR, QTYPE_PTR, QTYPE_X25, QTYPE_NSAP, - QTYPE_NSAPPTR: - R := DecodeLabels(j); - QTYPE_SOA: - begin - R := DecodeLabels(j); - R := R + ',' + DecodeLabels(j); - for n := 1 to 5 do + if Length(FBuffer) >= i then + case RType of + QTYPE_A: begin - x := DecodeInt(FBuffer, j) * 65536 + DecodeInt(FBuffer, j + 2); - Inc(j, 4); - R := R + ',' + IntToStr(x); + R := IntToStr(Ord(FBuffer[j])); + Inc(j); + R := R + '.' + IntToStr(Ord(FBuffer[j])); + Inc(j); + R := R + '.' + IntToStr(Ord(FBuffer[j])); + Inc(j); + R := R + '.' + IntToStr(Ord(FBuffer[j])); end; - end; - QTYPE_NULL: - begin - end; - QTYPE_WKS: - begin - end; - QTYPE_HINFO: - begin + QTYPE_AAAA: + begin + FillChar(ip6, SizeOf(ip6), 0); + ip6.sin6_addr.S_un_b.s_b1 := FBuffer[j]; + ip6.sin6_addr.S_un_b.s_b2 := FBuffer[j + 1]; + ip6.sin6_addr.S_un_b.s_b3 := FBuffer[j + 2]; + ip6.sin6_addr.S_un_b.s_b4 := FBuffer[j + 3]; + ip6.sin6_addr.S_un_b.s_b5 := FBuffer[j + 4]; + ip6.sin6_addr.S_un_b.s_b6 := FBuffer[j + 5]; + ip6.sin6_addr.S_un_b.s_b7 := FBuffer[j + 6]; + ip6.sin6_addr.S_un_b.s_b8 := FBuffer[j + 7]; + ip6.sin6_addr.S_un_b.s_b9 := FBuffer[j + 8]; + ip6.sin6_addr.S_un_b.s_b10 := FBuffer[j + 9]; + ip6.sin6_addr.S_un_b.s_b11 := FBuffer[j + 10]; + ip6.sin6_addr.S_un_b.s_b12 := FBuffer[j + 11]; + ip6.sin6_addr.S_un_b.s_b13 := FBuffer[j + 12]; + ip6.sin6_addr.S_un_b.s_b14 := FBuffer[j + 13]; + ip6.sin6_addr.S_un_b.s_b15 := FBuffer[j + 14]; + ip6.sin6_addr.S_un_b.s_b16 := FBuffer[j + 15]; + ip6.sin6_family := AF_INET6; + R := FSock.IP6ToStr(ip6); + end; + QTYPE_NS, QTYPE_MD, QTYPE_MF, QTYPE_CNAME, QTYPE_MB, + QTYPE_MG, QTYPE_MR, QTYPE_PTR, QTYPE_X25, QTYPE_NSAP, + QTYPE_NSAPPTR: + R := DecodeLabels(j); + QTYPE_SOA: + begin + R := DecodeLabels(j); + R := R + ',' + DecodeLabels(j); + for n := 1 to 5 do + begin + x := DecodeInt(FBuffer, j) * 65536 + DecodeInt(FBuffer, j + 2); + Inc(j, 4); + R := R + ',' + IntToStr(x); + end; + end; + QTYPE_NULL: + begin + end; + QTYPE_WKS: + begin + end; + QTYPE_HINFO: + begin + R := DecodeString(j); + R := R + ',' + DecodeString(j); + end; + QTYPE_MINFO, QTYPE_RP, QTYPE_ISDN: + begin + R := DecodeLabels(j); + R := R + ',' + DecodeLabels(j); + end; + QTYPE_MX, QTYPE_AFSDB, QTYPE_RT, QTYPE_KX: + begin + x := DecodeInt(FBuffer, j); + Inc(j, 2); + R := IntToStr(x); + R := R + ',' + DecodeLabels(j); + end; + QTYPE_TXT: R := DecodeString(j); - R := R + ',' + DecodeString(j); - end; - QTYPE_MINFO, QTYPE_RP, QTYPE_ISDN: - begin - R := DecodeLabels(j); - R := R + ',' + DecodeLabels(j); - end; - QTYPE_MX, QTYPE_AFSDB, QTYPE_RT, QTYPE_KX: - begin - x := DecodeInt(FBuffer, j); - Inc(j, 2); - R := IntToStr(x); - R := R + ',' + DecodeLabels(j); - end; - QTYPE_TXT: - R := DecodeString(j); - QTYPE_GPOS: - begin - R := DecodeLabels(j); - R := R + ',' + DecodeLabels(j); - R := R + ',' + DecodeLabels(j); - end; - QTYPE_PX: - begin - x := DecodeInt(FBuffer, j); - Inc(j, 2); - R := IntToStr(x); - R := R + ',' + DecodeLabels(j); - R := R + ',' + DecodeLabels(j); - end; - end; + QTYPE_GPOS: + begin + R := DecodeLabels(j); + R := R + ',' + DecodeLabels(j); + R := R + ',' + DecodeLabels(j); + end; + QTYPE_PX: + begin + x := DecodeInt(FBuffer, j); + Inc(j, 2); + R := IntToStr(x); + R := R + ',' + DecodeLabels(j); + R := R + ',' + DecodeLabels(j); + end; + end; if R <> '' then Info.Add(RName + ',' + IntToStr(RType) + ',' + IntToStr(ttl) + ',' + R); if QType = RType then @@ -415,6 +478,8 @@ begin Result := False; if IsIP(Name) then Name := ReverseIP(Name) + '.in-addr.arpa'; + if IsIP6(Name) then + Name := ReverseIP6(Name) + '.ip6.int'; FBuffer := CodeHeader + CodeQuery(Name, QType); if FUseTCP then WorkSock := FTCPSock diff --git a/ftpsend.pas b/ftpsend.pas index 2afb4cc..c95ad37 100644 --- a/ftpsend.pas +++ b/ftpsend.pas @@ -1,5 +1,5 @@ {==============================================================================| -| Project : Delphree - Synapse | 002.005.004 | +| Project : Delphree - Synapse | 002.006.006 | |==============================================================================| | Content: FTP client | |==============================================================================| @@ -43,8 +43,6 @@ | (Found at URL: http://www.ararat.cz/synapse/) | |==============================================================================} -{$WEAKPACKAGEUNIT ON} - unit FTPsend; interface @@ -121,8 +119,6 @@ type function InternalStor(const Command: string; RestoreAt: integer): Boolean; function DataSocket: Boolean; function AcceptDataSocket: Boolean; - function DataRead(const DestStream: TStream): Boolean; - function DataWrite(const SourceStream: TStream): Boolean; protected procedure DoStatus(Response: Boolean; const Value: string); public @@ -131,12 +127,13 @@ type destructor Destroy; override; function ReadResult: Integer; procedure ParseRemote(Value: string); + procedure ParseRemoteEPSV(Value: string); function FTPCommand(const Value: string): integer; function Login: Boolean; procedure Logout; procedure Abort; function List(Directory: string; NameList: Boolean): Boolean; - function RetriveFile(const FileName: string; Restore: Boolean): Boolean; + function RetrieveFile(const FileName: string; Restore: Boolean): Boolean; function StoreFile(const FileName: string; Restore: Boolean): Boolean; function StoreUniqueFile: Boolean; function AppendFile(const FileName: string): Boolean; @@ -149,6 +146,8 @@ type function DeleteDir(const Directory: string): Boolean; function CreateDir(const Directory: string): Boolean; function GetCurrentDir: String; + function DataRead(const DestStream: TStream): Boolean; + function DataWrite(const SourceStream: TStream): Boolean; published property ResultCode: Integer read FResultCode; property ResultString: string read FResultString; @@ -447,14 +446,14 @@ end; function TFTPSend.Connect: Boolean; begin FSock.CloseSocket; - FSock.CreateSocket; + FSock.Bind(FIPInterface, cAnyPort); if FFullSSL then FSock.SSLEnabled := True; - FSock.Bind(FIPInterface, cAnyPort); - if FFWHost = '' then - FSock.Connect(FTargetHost, FTargetPort) - else - FSock.Connect(FFWHost, FFWPort); + if FSock.LastError = 0 then + if FFWHost = '' then + FSock.Connect(FTargetHost, FTargetPort) + else + FSock.Connect(FFWHost, FFWPort); Result := FSock.LastError = 0; end; @@ -527,6 +526,24 @@ begin FDataPort := IntToStr(x); end; +procedure TFTPSend.ParseRemoteEPSV(Value: string); +var + n: integer; + s, v: string; +begin + s := SeparateRight(Value, '('); + s := SeparateLeft(s, ')'); + Delete(s, Length(s), 1); + v := ''; + for n := Length(s) downto 1 do + if s[n] in ['0'..'9'] then + v := s[n] + v + else + Break; + FDataPort := v; + FDataIP := FTargetHost; +end; + function TFTPSend.DataSocket: boolean; var s: string; @@ -534,19 +551,31 @@ begin Result := False; if FPassiveMode then begin - if (FTPCommand('PASV') div 100) <> 2 then - Exit; - ParseRemote(FResultString); + if FSock.IP6used then + s := '2' + else + s := '1'; + if (FTPCommand('EPSV ' + s) div 100) = 2 then + begin + ParseRemoteEPSV(FResultString); + end + else + if FSock.IP6used then + Exit + else + begin + if (FTPCommand('PASV') div 100) <> 2 then + Exit; + ParseRemote(FResultString); + end; FDSock.CloseSocket; - FDSock.CreateSocket; - FSock.Bind(FIPInterface, cAnyPort); + FDSock.Bind(FIPInterface, cAnyPort); FDSock.Connect(FDataIP, FDataPort); Result := FDSock.LastError = 0; end else begin FDSock.CloseSocket; - FDSock.CreateSocket; if FForceDefaultPort then s := cFtpDataProtocol else @@ -555,7 +584,7 @@ begin if FIPInterface = cAnyHost then FDSock.Bind(FDSock.LocalName, s) else - FSock.Bind(FIPInterface, s); + FDSock.Bind(FIPInterface, s); if FDSock.LastError <> 0 then Exit; FDSock.SetLinger(True, 10); @@ -564,10 +593,19 @@ begin FDataIP := FDSock.GetLocalSinIP; FDataIP := FDSock.ResolveName(FDataIP); FDataPort := IntToStr(FDSock.GetLocalSinPort); - s := ReplaceString(FDataIP, '.', ','); - s := 'PORT ' + s + ',' + IntToStr(FDSock.GetLocalSinPort div 256) - + ',' + IntToStr(FDSock.GetLocalSinPort mod 256); + if IsIp6(FDataIP) then + s := '2' + else + s := '1'; + s := 'EPRT |' + s +'|' + FDataIP + '|' + FDataPort + '|'; Result := (FTPCommand(s) div 100) = 2; + if not Result and IsIP(FDataIP) then + begin + s := ReplaceString(FDataIP, '.', ','); + s := 'PORT ' + s + ',' + IntToStr(FDSock.GetLocalSinPort div 256) + + ',' + IntToStr(FDSock.GetLocalSinPort mod 256); + Result := (FTPCommand(s) div 100) = 2; + end; end; end; @@ -687,7 +725,7 @@ begin FDataStream.Seek(0, soFromBeginning); end; -function TFTPSend.RetriveFile(const FileName: string; Restore: Boolean): Boolean; +function TFTPSend.RetrieveFile(const FileName: string; Restore: Boolean): Boolean; var RetrStream: TStream; begin @@ -1156,7 +1194,7 @@ begin Exit; DirectFileName := LocalFile; DirectFile:=True; - Result := RetriveFile(FileName, False); + Result := RetrieveFile(FileName, False); Logout; finally Free; diff --git a/httpsend.pas b/httpsend.pas index bbf2c6b..0048bd8 100644 --- a/httpsend.pas +++ b/httpsend.pas @@ -1,5 +1,5 @@ {==============================================================================| -| Project : Delphree - Synapse | 003.004.004 | +| Project : Delphree - Synapse | 003.006.004 | |==============================================================================| | Content: HTTP client | |==============================================================================| @@ -42,14 +42,15 @@ | (Found at URL: http://www.ararat.cz/synapse/) | |==============================================================================} -{$WEAKPACKAGEUNIT ON} - unit HTTPSend; interface uses SysUtils, Classes, + {$IFDEF STREAMSEC} + TlsInternalServer, TlsSynaSock, + {$ENDIF} blcksock, SynaUtil, SynaCode; const @@ -60,7 +61,12 @@ type THTTPSend = class(TSynaClient) private + {$IFDEF STREAMSEC} + FSock: TSsTCPBlockSocket; + FTLSServer: TCustomTLSInternalServer; + {$ELSE} FSock: TTCPBlockSocket; + {$ENDIF} FTransferEncoding: TTransferEncoding; FAliveHost: string; FAlivePort: string; @@ -69,6 +75,7 @@ type FMimeType: string; FProtocol: string; FKeepAlive: Boolean; + FStatus100: Boolean; FProxyHost: string; FProxyPort: string; FProxyUser: string; @@ -101,6 +108,7 @@ type property MimeType: string read FMimeType Write FMimeType; property Protocol: string read FProtocol Write FProtocol; property KeepAlive: Boolean read FKeepAlive Write FKeepAlive; + property Status100: Boolean read FStatus100 Write FStatus100; property ProxyHost: string read FProxyHost Write FProxyHost; property ProxyPort: string read FProxyPort Write FProxyPort; property ProxyUser: string read FProxyUser Write FProxyUser; @@ -110,7 +118,12 @@ type property ResultString: string read FResultString; property DownloadSize: integer read FDownloadSize; property UploadSize: integer read FUploadSize; +{$IFDEF STREAMSEC} + property Sock: TSsTCPBlockSocket read FSock; + property TLSServer: TCustomTLSInternalServer read FTLSServer write FTLSServer; +{$ELSE} property Sock: TTCPBlockSocket read FSock; +{$ENDIF} end; function HttpGetText(const URL: string; const Response: TStrings): Boolean; @@ -128,11 +141,17 @@ begin FHeaders := TStringList.Create; FCookies := TStringList.Create; FDocument := TMemoryStream.Create; +{$IFDEF STREAMSEC} + FTLSServer := GlobalTLSInternalServer; + FSock := TSsTCPBlockSocket.Create; + FSock.BlockingRead := True; +{$ELSE} FSock := TTCPBlockSocket.Create; +{$ENDIF} FSock.ConvertLineEnd := True; FSock.SizeRecvBuffer := 65536; FSock.SizeSendBuffer := 65536; - FTimeout := 300000; + FTimeout := 90000; FTargetPort := cHttpProtocol; FProxyHost := ''; FProxyPort := '8080'; @@ -142,6 +161,7 @@ begin FAlivePort := ''; FProtocol := '1.0'; FKeepAlive := True; + FStatus100 := False; FUserAgent := 'Mozilla/4.0 (compatible; Synapse)'; FDownloadSize := 0; FUploadSize := 0; @@ -198,10 +218,8 @@ begin FUploadSize := 0; URI := ParseURL(URL, Prot, User, Pass, Host, Port, Path, Para); - if UpperCase(Prot) = 'HTTPS' then begin - FSock.SSLEnabled := True; HttpTunnel := FProxyHost <> ''; FSock.HTTPTunnelIP := FProxyHost; FSock.HTTPTunnelPort := FProxyPort; @@ -210,7 +228,6 @@ begin end else begin - FSock.SSLEnabled := False; HttpTunnel := False; FSock.HTTPTunnelIP := ''; FSock.HTTPTunnelPort := ''; @@ -220,7 +237,7 @@ begin Sending := Document.Size > 0; {Headers for Sending data} - status100 := Sending and (FProtocol = '1.1'); + status100 := FStatus100 and Sending and (FProtocol = '1.1'); if status100 then FHeaders.Insert(0, 'Expect: 100-continue'); if Sending then @@ -247,12 +264,16 @@ begin if (FProxyHost <> '') and (FProxyUser <> '') and not(HttpTunnel) then FHeaders.Insert(0, 'Proxy-Authorization: Basic ' + EncodeBase64(FProxyUser + ':' + FProxyPass)); - if Port<>'80' then - FHeaders.Insert(0, 'Host: ' + Host + ':' + Port) + if isIP6(Host) then + s := '[' + Host + ']' else - FHeaders.Insert(0, 'Host: ' + Host); + s := Host; + if Port<>'80' then + FHeaders.Insert(0, 'Host: ' + s + ':' + Port) + else + FHeaders.Insert(0, 'Host: ' + s); if (FProxyHost <> '') and not(HttpTunnel)then - URI := Prot + '://' + Host + ':' + Port + URI; + URI := Prot + '://' + s + ':' + Port + URI; if URI = '/*' then URI := '*'; if FProtocol = '0.9' then @@ -276,10 +297,21 @@ begin if (FAliveHost <> FTargetHost) or (FAlivePort <> FTargetPort) then begin FSock.CloseSocket; - FSock.CreateSocket; FSock.Bind(FIPInterface, cAnyPort); if FSock.LastError <> 0 then Exit; +{$IFDEF STREAMSEC} + FSock.TLSServer := nil; + if UpperCase(Prot) = 'HTTPS' then + if assigned(FTLSServer) then + FSock.TLSServer := FTLSServer + else + exit; +{$ELSE} + FSock.SSLEnabled := UpperCase(Prot) = 'HTTPS'; +{$ENDIF} + if FSock.LastError <> 0 then + Exit; FSock.Connect(FTargetHost, FTargetPort); if FSock.LastError <> 0 then Exit; @@ -291,10 +323,21 @@ begin if FSock.CanRead(0) then begin FSock.CloseSocket; - FSock.CreateSocket; FSock.Bind(FIPInterface, cAnyPort); if FSock.LastError <> 0 then Exit; +{$IFDEF STREAMSEC} + FSock.TLSServer := nil; + if UpperCase(Prot) = 'HTTPS' then + if assigned(FTLSServer) then + FSock.TLSServer := FTLSServer + else + exit; +{$ELSE} + FSock.SSLEnabled := UpperCase(Prot) = 'HTTPS'; +{$ENDIF} + if FSock.LastError <> 0 then + Exit; FSock.Connect(FTargetHost, FTargetPort); if FSock.LastError <> 0 then Exit; diff --git a/imapsend.pas b/imapsend.pas index 792def7..9a85bc3 100644 --- a/imapsend.pas +++ b/imapsend.pas @@ -1,5 +1,5 @@ {==============================================================================| -| Project : Delphree - Synapse | 002.002.002 | +| Project : Delphree - Synapse | 002.003.005 | |==============================================================================| | Content: IMAP4rev1 client | |==============================================================================| @@ -42,8 +42,6 @@ | (Found at URL: http://www.ararat.cz/synapse/) | |==============================================================================} -{$WEAKPACKAGEUNIT ON} - //RFC-2060 //RFC-2595 @@ -53,6 +51,9 @@ interface uses SysUtils, Classes, + {$IFDEF STREAMSEC} + TlsInternalServer, TlsSynaSock, + {$ENDIF} blcksock, SynaUtil, SynaCode; const @@ -61,7 +62,12 @@ const type TIMAPSend = class(TSynaClient) private + {$IFDEF STREAMSEC} + FSock: TSsTCPBlockSocket; + FTLSServer: TCustomTLSInternalServer; + {$ELSE} FSock: TTCPBlockSocket; + {$ENDIF} FTagCommand: integer; FResultString: string; FFullResult: TStringList; @@ -83,6 +89,7 @@ type procedure ParseFolderList(Value:TStrings); procedure ParseSelect; procedure ParseSearch(Value:TStrings); + procedure ProcessLiterals; public constructor Create; destructor Destroy; override; @@ -125,13 +132,18 @@ type property Password: string read FPassword Write FPassword; property AuthDone: Boolean read FAuthDone; property UID: Boolean read FUID Write FUID; - property Sock: TTCPBlockSocket read FSock; property SelectedFolder: string read FSelectedFolder; property SelectedCount: integer read FSelectedCount; property SelectedRecent: integer read FSelectedRecent; property SelectedUIDvalidity: integer read FSelectedUIDvalidity; property AutoTLS: Boolean read FAutoTLS Write FAutoTLS; property FullSSL: Boolean read FFullSSL Write FFullSSL; +{$IFDEF STREAMSEC} + property Sock: TSsTCPBlockSocket read FSock; + property TLSServer: TCustomTLSInternalServer read FTLSServer write FTLSServer; +{$ELSE} + property Sock: TTCPBlockSocket read FSock; +{$ENDIF} end; implementation @@ -141,12 +153,17 @@ begin inherited Create; FFullResult := TStringList.Create; FIMAPcap := TStringList.Create; +{$IFDEF STREAMSEC} + FTLSServer := GlobalTLSInternalServer; + FSock := TSsTCPBlockSocket.Create; + FSock.BlockingRead := True; +{$ELSE} FSock := TTCPBlockSocket.Create; +{$ENDIF} FSock.ConvertLineEnd := True; - FSock.CreateSocket; FSock.SizeRecvBuffer := 32768; FSock.SizeSendBuffer := 32768; - FTimeout := 300000; + FTimeout := 60000; FTargetPort := cIMAPProtocol; FUsername := ''; FPassword := ''; @@ -203,6 +220,47 @@ begin Result:=uppercase(separateleft(s, ' ')); end; +procedure TIMAPSend.ProcessLiterals; +var + l: TStringList; + n, x: integer; + b: integer; + s: string; +begin + l := TStringList.Create; + try + l.Assign(FFullResult); + FFullResult.Clear; + b := 0; + for n := 0 to l.Count - 1 do + begin + s := l[n]; + if b > 0 then + begin + FFullResult[FFullresult.Count - 1] := + FFullResult[FFullresult.Count - 1] + s; + inc(b); + if b > 2 then + b := 0; + end + else + begin + if (s <> '') and (s[Length(s)]='}') then + begin + x := RPos('{', s); + Delete(s, x, Length(s) - x + 1); + b := 1; + end + else + b := 0; + FFullResult.Add(s); + end; + end; + finally + l.Free; + end; +end; + function TIMAPSend.IMAPcommand(Value: string): string; begin Inc(FTagCommand); @@ -240,6 +298,7 @@ var n, x: integer; s: string; begin + ProcessLiterals; Value.Clear; for n := 0 to FFullResult.Count - 1 do begin @@ -264,6 +323,7 @@ var n: integer; s, t: string; begin + ProcessLiterals; FSelectedCount := 0; FSelectedRecent := 0; FSelectedUIDvalidity := 0; @@ -296,6 +356,7 @@ var n: integer; s: string; begin + ProcessLiterals; Value.Clear; for n := 0 to FFullResult.Count - 1 do begin @@ -326,17 +387,32 @@ end; function TIMAPSend.AuthLogin: Boolean; begin - Result := IMAPcommand('LOGIN ' + FUsername + ' ' + FPassword) = 'OK'; + Result := IMAPcommand('LOGIN "' + FUsername + '" "' + FPassword + '"') = 'OK'; end; function TIMAPSend.Connect: Boolean; begin FSock.CloseSocket; - FSock.CreateSocket; + FSock.Bind(FIPInterface, cAnyPort); +{$IFDEF STREAMSEC} + if FFullSSL then + begin + if assigned(FTLSServer) then + FSock.TLSServer := FTLSServer + else + begin + Result := false; + exit; + end; + end + else + FSock.TLSServer := nil; +{$ELSE} if FFullSSL then FSock.SSLEnabled := True; - FSock.Bind(FIPInterface, cAnyPort); - FSock.Connect(FTargetHost, FTargetPort); +{$ENDIF} + if FSock.LastError = 0 then + FSock.Connect(FTargetHost, FTargetPort); Result := FSock.LastError = 0; end; @@ -350,6 +426,7 @@ begin s := IMAPcommand('CAPABILITY'); if s = 'OK' then begin + ProcessLiterals; for n := 0 to FFullResult.Count - 1 do if Pos('* CAPABILITY ', FFullResult[n]) = 1 then begin @@ -475,10 +552,12 @@ begin Result := -1; Value := Uppercase(Value); if IMAPcommand('STATUS "' + FolderName + '" (' + Value + ')' ) = 'OK' then + begin + ProcessLiterals; for n := 0 to FFullResult.Count - 1 do begin s := UpperCase(FFullResult[n]); - if (Pos(FolderName, s) >= 1) and (Pos(Value, s) > 0 ) then + if (Pos('* ', s) = 1) and (Pos(FolderName, s) >= 1) and (Pos(Value, s) > 0 ) then begin t := SeparateRight(s, Value); t := SeparateLeft(t, ')'); @@ -487,6 +566,7 @@ begin Break; end; end; + end; end; function TIMAPSend.ExpungeFolder: Boolean; @@ -546,6 +626,8 @@ begin if FUID then s := 'UID ' + s; if IMAPcommand(s) = 'OK' then + begin + ProcessLiterals; for n := 0 to FFullResult.Count - 1 do begin s := UpperCase(FFullResult[n]); @@ -558,6 +640,7 @@ begin Break; end; end; + end; end; function TIMAPSend.CopyMess(MessID: integer; ToFolder: string): Boolean; @@ -601,6 +684,7 @@ begin if FUID then s := 'UID ' + s; Result := IMAPcommand(s) = 'OK'; + ProcessLiterals; for n := 0 to FFullResult.Count - 1 do begin s := uppercase(FFullResult[n]); @@ -620,7 +704,14 @@ begin begin if IMAPcommand('STARTTLS') = 'OK' then begin +{$IFDEF STREAMSEC} + if not assigned(FTLSServer) then + Exit; + Fsock.TLSServer := FTLSServer; + FSock.Connect('',''); +{$ELSE} Fsock.SSLDoConnect; +{$ENDIF} Result := FSock.LastError = 0; end; end; @@ -635,6 +726,7 @@ begin sUID := ''; s := 'FETCH ' + IntToStr(MessID) + ' UID'; Result := IMAPcommand(s) = 'OK'; + ProcessLiterals; for n := 0 to FFullResult.Count - 1 do begin s := uppercase(FFullResult[n]); diff --git a/mimeinln.pas b/mimeinln.pas index 4a132da..6291d21 100644 --- a/mimeinln.pas +++ b/mimeinln.pas @@ -1,5 +1,5 @@ {==============================================================================| -| Project : Delphree - Synapse | 001.000.005 | +| Project : Delphree - Synapse | 001.000.007 | |==============================================================================| | Content: Inline MIME support procedures and functions | |==============================================================================| @@ -42,8 +42,6 @@ | (Found at URL: http://www.ararat.cz/synapse/) | |==============================================================================} -{$WEAKPACKAGEUNIT ON} - unit MIMEinLn; interface @@ -92,6 +90,9 @@ begin v := Value; x := Pos('=?', v); y := SearchEndInline(v, x); + //fix for broken coding with begin, but not with end. + if (x > 0) and (y <= 0) then + y := Length(Result); while (y > x) and (x > 0) do begin s := Copy(v, 1, x - 1); diff --git a/mimemess.pas b/mimemess.pas index 669ecc8..978fd04 100644 --- a/mimemess.pas +++ b/mimemess.pas @@ -1,5 +1,5 @@ {==============================================================================| -| Project : Delphree - Synapse | 002.001.002 | +| Project : Delphree - Synapse | 002.001.003 | |==============================================================================| | Content: MIME message object | |==============================================================================| @@ -42,8 +42,6 @@ | (Found at URL: http://www.ararat.cz/synapse/) | |==============================================================================} -{$WEAKPACKAGEUNIT ON} - unit MIMEmess; interface diff --git a/mimepart.pas b/mimepart.pas index 03c6662..8d51ec5 100644 --- a/mimepart.pas +++ b/mimepart.pas @@ -1,5 +1,5 @@ {==============================================================================| -| Project : Delphree - Synapse | 002.003.002 | +| Project : Delphree - Synapse | 002.003.004 | |==============================================================================| | Content: MIME support procedures and functions | |==============================================================================| @@ -695,7 +695,8 @@ begin s := CharsetConversion(s, FTargetCharset, FCharsetCode); if FEncodingCode = ME_QUOTED_PRINTABLE then begin - s := EncodeQuotedPrintable(s); + s := EncodeTriplet(s, '=', [Char(1)..Char(31), '=', Char(128)..Char(255)]); +// s := EncodeQuotedPrintable(s); repeat if Length(s) < FMaxLineLength then begin @@ -813,7 +814,7 @@ begin if Primary = '' then Primary := 'application'; if FSecondary = '' then - FSecondary := 'octet-string'; + FSecondary := 'octet-stream'; end; {==============================================================================} diff --git a/nntpsend.pas b/nntpsend.pas index d60d576..4b3a110 100644 --- a/nntpsend.pas +++ b/nntpsend.pas @@ -1,5 +1,5 @@ {==============================================================================| -| Project : Delphree - Synapse | 001.002.003 | +| Project : Delphree - Synapse | 001.003.001 | |==============================================================================| | Content: NNTP client | |==============================================================================| @@ -42,14 +42,15 @@ | (Found at URL: http://www.ararat.cz/synapse/) | |==============================================================================} -{$WEAKPACKAGEUNIT ON} - unit NNTPsend; interface uses SysUtils, Classes, + {$IFDEF STREAMSEC} + TlsInternalServer, TlsSynaSock, + {$ENDIF} blcksock, SynaUtil, SynaCode; const @@ -58,13 +59,21 @@ const type TNNTPSend = class(TSynaClient) private + {$IFDEF STREAMSEC} + FSock: TSsTCPBlockSocket; + FTLSServer: TCustomTLSInternalServer; + {$ELSE} FSock: TTCPBlockSocket; + {$ENDIF} FResultCode: Integer; FResultString: string; FData: TStringList; FDataToSend: TStringList; FUsername: string; FPassword: string; + FAutoTLS: Boolean; + FFullSSL: Boolean; + FNNTPcap: TStringList; function ReadResult: Integer; function ReadData: boolean; function SendData: boolean; @@ -91,13 +100,23 @@ type function PostArticle: Boolean; function SwitchToSlave: Boolean; function Xover(xoStart, xoEnd: string): boolean; + function StartTLS: Boolean; + function FindCap(const Value: string): string; + function ListExtensions: Boolean; published property Username: string read FUsername write FUsername; property Password: string read FPassword write FPassword; property ResultCode: Integer read FResultCode; property ResultString: string read FResultString; property Data: TStringList read FData; + property AutoTLS: Boolean read FAutoTLS Write FAutoTLS; + property FullSSL: Boolean read FFullSSL Write FFullSSL; +{$IFDEF STREAMSEC} + property Sock: TSsTCPBlockSocket read FSock; + property TLSServer: TCustomTLSInternalServer read FTLSServer write FTLSServer; +{$ELSE} property Sock: TTCPBlockSocket read FSock; +{$ENDIF} end; implementation @@ -105,14 +124,23 @@ implementation constructor TNNTPSend.Create; begin inherited Create; +{$IFDEF STREAMSEC} + FTLSServer := GlobalTLSInternalServer; + FSock := TSsTCPBlockSocket.Create; + FSock.BlockingRead := True; +{$ELSE} + FSock := TTCPBlockSocket.Create; +{$ENDIF} FData := TStringList.Create; FDataToSend := TStringList.Create; - FSock := TTCPBlockSocket.Create; + FNNTPcap := TStringList.Create; FSock.ConvertLineEnd := True; - FTimeout := 300000; + FTimeout := 60000; FTargetPort := cNNTPProtocol; FUsername := ''; FPassword := ''; + FAutoTLS := False; + FFullSSL := False; end; destructor TNNTPSend.Destroy; @@ -120,6 +148,7 @@ begin FSock.Free; FDataToSend.Free; FData.Free; + FNNTPcap.Free; inherited Destroy; end; @@ -179,16 +208,40 @@ function TNNTPSend.Connect: Boolean; begin FSock.CloseSocket; FSock.Bind(FIPInterface, cAnyPort); - FSock.Connect(FTargetHost, FTargetPort); +{$IFDEF STREAMSEC} + if FFullSSL then + begin + if assigned(FTLSServer) then + FSock.TLSServer := FTLSServer; + else + begin + result := False; + Exit; + end; + end + else + FSock.TLSServer := nil; +{$ELSE} + if FFullSSL then + FSock.SSLEnabled := True; +{$ENDIF} + if FSock.LastError = 0 then + FSock.Connect(FTargetHost, FTargetPort); Result := FSock.LastError = 0; end; function TNNTPSend.Login: Boolean; begin Result := False; + FNNTPcap.Clear; if not Connect then Exit; Result := (ReadResult div 100) = 2; + ListExtensions; + FNNTPcap.Assign(Fdata); + if result then + if (not FullSSL) and FAutoTLS and (FindCap('STARTTLS') <> '') then + result := StartTLS; if (FUsername <> '') and Result then begin FSock.SendString('AUTHINFO USER ' + FUsername + CRLF); @@ -335,6 +388,50 @@ begin Result := DoCommandRead(s); end; +function TNNTPSend.StartTLS: Boolean; +begin + Result := False; + if FindCap('STARTTLS') <> '' then + begin + if DoCommand('STARTTLS') then + begin +{$IFDEF STREAMSEC} + if (Assigned(FTLSServer) then + begin + Fsock.TLSServer := FTLSServer; + Fsock.Connect('',''); + Result := FSock.LastError = 0; + end + else + Result := False; +{$ELSE} + Fsock.SSLDoConnect; + Result := FSock.LastError = 0; +{$ENDIF} + end; + end; +end; + +function TNNTPSend.ListExtensions: Boolean; +begin + Result := DoCommandRead('LIST EXTENSIONS'); +end; + +function TNNTPSend.FindCap(const Value: string): string; +var + n: Integer; + s: string; +begin + s := UpperCase(Value); + Result := ''; + for n := 0 to FNNTPcap.Count - 1 do + if Pos(s, UpperCase(FNNTPcap[n])) = 1 then + begin + Result := FNNTPcap[n]; + Break; + end; +end; + {==============================================================================} end. diff --git a/pingsend.pas b/pingsend.pas index 5e50963..d5316bc 100644 --- a/pingsend.pas +++ b/pingsend.pas @@ -1,5 +1,5 @@ {==============================================================================| -| Project : Delphree - Synapse | 002.003.001 | +| Project : Delphree - Synapse | 003.000.002 | |==============================================================================| | Content: PING sender | |==============================================================================| @@ -42,14 +42,8 @@ | (Found at URL: http://www.ararat.cz/synapse/) | |==============================================================================} -{ -!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! -See 'winsock2.txt' file in distribute package! -!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! -} - {$Q-} -{$WEAKPACKAGEUNIT ON} +{$R-} unit PINGsend; @@ -67,6 +61,8 @@ uses const ICMP_ECHO = 8; ICMP_ECHOREPLY = 0; + ICMP6_ECHO = 128; + ICMP6_ECHOREPLY = 129; type TIcmpEchoHeader = record @@ -75,7 +71,17 @@ type i_checkSum: Word; i_Id: Word; i_seq: Word; - TimeStamp: ULONG; + TimeStamp: ULong; + end; + + TICMP6Packet = record + in_source: TInAddr6; + in_dest: TInAddr6; + Length: integer; + free0: Byte; + free1: Byte; + free2: Byte; + proto: Byte; end; TPINGSend = class(TSynaClient) @@ -86,7 +92,10 @@ type FId: Integer; FPacketSize: Integer; FPingTime: Integer; - function Checksum: Integer; + FIcmpEcho: Byte; + FIcmpEchoReply: Byte; + function Checksum(Value: string): Word; + function Checksum6(Value: string): Word; function ReadPacket: Boolean; public function Ping(const Host: string): Boolean; @@ -108,7 +117,6 @@ constructor TPINGSend.Create; begin inherited Create; FSock := TICMPBlockSocket.Create; - FSock.CreateSocket; FTimeout := 5000; FPacketSize := 32; FSeq := 0; @@ -136,13 +144,27 @@ var t: Boolean; begin Result := False; + FPingTime := -1; FSock.Bind(FIPInterface, cAnyPort); FSock.Connect(Host, '0'); + if FSock.LastError <> 0 then + Exit; + FSock.SizeRecvBuffer := 60 * 1024; + if FSock.IP6used then + begin + FIcmpEcho := ICMP6_ECHO; + FIcmpEchoReply := ICMP6_ECHOREPLY; + end + else + begin + FIcmpEcho := ICMP_ECHO; + FIcmpEchoReply := ICMP_ECHOREPLY; + end; FBuffer := StringOfChar(#0, SizeOf(TICMPEchoHeader) + FPacketSize); IcmpEchoHeaderPtr := Pointer(FBuffer); with IcmpEchoHeaderPtr^ do begin - i_type := ICMP_ECHO; + i_type := FIcmpEcho; i_code := 0; i_CheckSum := 0; FId := Random(32767); @@ -152,28 +174,43 @@ begin i_Seq := FSeq; for n := Succ(SizeOf(TIcmpEchoHeader)) to Length(FBuffer) do FBuffer[n] := #$55; - i_CheckSum := CheckSum; end; + if fSock.IP6used then + IcmpEchoHeaderPtr^.i_CheckSum := CheckSum6(FBuffer) + else + IcmpEchoHeaderPtr^.i_CheckSum := CheckSum(FBuffer); FSock.SendString(FBuffer); repeat t := ReadPacket; if not t then break; - IPHeadPtr := Pointer(FBuffer); - IpHdrLen := (IPHeadPtr^.VerLen and $0F) * 4; - IcmpEchoHeaderPtr := @FBuffer[IpHdrLen + 1]; - until (IcmpEchoHeaderPtr^.i_type <> ICMP_ECHO) and (IcmpEchoHeaderPtr^.i_id = FId); + if fSock.IP6used then + begin +{$IFDEF LINUX} + IcmpEchoHeaderPtr := Pointer(FBuffer); +{$ELSE} + FBuffer := StringOfChar(#0, 4) + FBuffer; + IcmpEchoHeaderPtr := Pointer(FBuffer); + IcmpEchoHeaderPtr^.i_type := FIcmpEchoReply; +{$ENDIF} + end + else + begin + IPHeadPtr := Pointer(FBuffer); + IpHdrLen := (IPHeadPtr^.VerLen and $0F) * 4; + IcmpEchoHeaderPtr := @FBuffer[IpHdrLen + 1]; + end; + until (IcmpEchoHeaderPtr^.i_type <> FIcmpEcho) and (IcmpEchoHeaderPtr^.i_id = FId); //it discard sometimes possible 'echoes' of previosly sended packet... if t then - if (IcmpEchoHeaderPtr^.i_type = ICMP_ECHOREPLY) then - if (IcmpEchoHeaderPtr^.i_id = FId) then - begin - FPingTime := GetTick - IcmpEchoHeaderPtr^.TimeStamp; - Result := True; - end; + if (IcmpEchoHeaderPtr^.i_type = FIcmpEchoReply) then + begin + FPingTime := TickDelta(IcmpEchoHeaderPtr^.TimeStamp, GetTick); + Result := True; + end; end; -function TPINGSend.Checksum: Integer; +function TPINGSend.Checksum(Value: string): Word; type TWordArray = array[0..0] of Word; var @@ -182,29 +219,60 @@ var Num, Remain: Integer; n: Integer; begin - Num := Length(FBuffer) div 2; - Remain := Length(FBuffer) mod 2; - WordArr := Pointer(FBuffer); + Num := Length(Value) div 2; + Remain := Length(Value) mod 2; + WordArr := Pointer(Value); CkSum := 0; for n := 0 to Num - 1 do CkSum := CkSum + WordArr^[n]; if Remain <> 0 then - CkSum := CkSum + Ord(FBuffer[Length(FBuffer)]); + CkSum := CkSum + Ord(Value[Length(Value)]); CkSum := (CkSum shr 16) + (CkSum and $FFFF); CkSum := CkSum + (CkSum shr 16); Result := Word(not CkSum); end; +function TPINGSend.Checksum6(Value: string): Word; +const + IOC_OUT = $40000000; + IOC_IN = $80000000; + IOC_INOUT = (IOC_IN or IOC_OUT); + IOC_WS2 = $08000000; + SIO_ROUTING_INTERFACE_QUERY = 20 or IOC_WS2 or IOC_INOUT; +var + ICMP6Ptr: ^TICMP6Packet; + s: string; + b: integer; + ip6: TSockAddrIn6; + x: integer; +begin +{$IFDEF LINUX} + Result := 0; +{$ELSE} + s := StringOfChar(#0, SizeOf(TICMP6Packet)) + Value; + ICMP6Ptr := Pointer(s); + x := synsock.WSAIoctl(FSock.Socket, SIO_ROUTING_INTERFACE_QUERY, + @FSock.RemoteSin.IP6, SizeOf(FSock.RemoteSin.IP6), + @ip6, SizeOf(ip6), @b, nil, nil); + if x <> -1 then + ICMP6Ptr^.in_dest := ip6.sin6_addr + else + ICMP6Ptr^.in_dest := FSock.LocalSin.IP6.sin6_addr; + ICMP6Ptr^.in_source := FSock.RemoteSin.IP6.sin6_addr; + ICMP6Ptr^.Length := synsock.htonl(Length(Value)); + ICMP6Ptr^.proto := IPPROTO_ICMPV6; + Result := Checksum(s); +{$ENDIF} +end; + {==============================================================================} function PingHost(const Host: string): Integer; begin with TPINGSend.Create do try - if Ping(Host) then - Result := PingTime - else - Result := -1; + Ping(Host); + Result := PingTime; finally Free; end; diff --git a/pop3send.pas b/pop3send.pas index 63aff73..31115b8 100644 --- a/pop3send.pas +++ b/pop3send.pas @@ -1,5 +1,5 @@ {==============================================================================| -| Project : Delphree - Synapse | 002.001.004 | +| Project : Delphree - Synapse | 002.001.008 | |==============================================================================| | Content: POP3 client | |==============================================================================| @@ -42,8 +42,6 @@ | (Found at URL: http://www.ararat.cz/synapse/) | |==============================================================================} -{$WEAKPACKAGEUNIT ON} - //RFC-1734 //RFC-1939 //RFC-2195 @@ -56,6 +54,9 @@ interface uses SysUtils, Classes, + {$IFDEF STREAMSEC} + TlsInternalServer, TlsSynaSock, + {$ENDIF} blcksock, SynaUtil, SynaCode; const @@ -66,7 +67,12 @@ type TPOP3Send = class(TSynaClient) private + {$IFDEF STREAMSEC} + FSock: TSsTCPBlockSocket; + FTLSServer: TCustomTLSInternalServer; + {$ELSE} FSock: TTCPBlockSocket; + {$ENDIF} FResultCode: Integer; FResultString: string; FFullResult: TStringList; @@ -109,9 +115,14 @@ type property StatSize: Integer read FStatSize; property TimeStamp: string read FTimeStamp; property AuthType: TPOP3AuthType read FAuthType Write FAuthType; - property Sock: TTCPBlockSocket read FSock; property AutoTLS: Boolean read FAutoTLS Write FAutoTLS; property FullSSL: Boolean read FFullSSL Write FFullSSL; +{$IFDEF STREAMSEC} + property Sock: TSsTCPBlockSocket read FSock; + property TLSServer: TCustomTLSInternalServer read FTLSServer write FTLSServer; +{$ELSE} + property Sock: TTCPBlockSocket read FSock; +{$ENDIF} end; implementation @@ -121,10 +132,15 @@ begin inherited Create; FFullResult := TStringList.Create; FPOP3cap := TStringList.Create; +{$IFDEF STREAMSEC} + FTLSServer := GlobalTLSInternalServer; + FSock := TSsTCPBlockSocket.Create; + FSock.BlockingRead := True; +{$ELSE} FSock := TTCPBlockSocket.Create; - FSock.CreateSocket; +{$ENDIF} FSock.ConvertLineEnd := true; - FTimeout := 300000; + FTimeout := 60000; FTargetPort := cPop3Protocol; FUsername := ''; FPassword := ''; @@ -192,11 +208,26 @@ begin FStatSize := 0; FSock.CloseSocket; FSock.LineBuffer := ''; - FSock.CreateSocket; + FSock.Bind(FIPInterface, cAnyPort); +{$IFDEF STREAMSEC} + if FFullSSL then + begin + if Assigned(FTLSServer) then + FSock.TLSServer := FTLSServer + else + begin + Result := false; + Exit; + end; + end + else + FSock.TLSServer := nil; +{$ELSE} if FFullSSL then FSock.SSLEnabled := True; - FSock.Bind(FIPInterface, cAnyPort); - FSock.Connect(FTargetHost, FTargetPort); +{$ENDIF} + if FSock.LastError = 0 then + FSock.Connect(FTargetHost, FTargetPort); Result := FSock.LastError = 0; end; @@ -321,8 +352,19 @@ begin FSock.SendString('STLS' + CRLF); if ReadResult(False) = 1 then begin +{$IFDEF STREAMSEC} + if Assigned(FTLSServer) then + begin + Fsock.TLSServer := FTLSServer; + Fsock.Connect('',''); + Result := FSock.LastError = 0; + end + else + Result := false; +{$ELSE} Fsock.SSLDoConnect; Result := FSock.LastError = 0; +{$ENDIF} end; end; diff --git a/slogsend.pas b/slogsend.pas index a106a8f..aa94e9c 100644 --- a/slogsend.pas +++ b/slogsend.pas @@ -1,5 +1,5 @@ {==============================================================================| -| Project : Delphree - Synapse | 001.001.001 | +| Project : Delphree - Synapse | 001.001.004 | |==============================================================================| | Content: SysLog client | |==============================================================================| @@ -45,7 +45,6 @@ // RFC-3164 {$Q-} -{$WEAKPACKAGEUNIT ON} unit SLogSend; @@ -114,13 +113,11 @@ constructor TSyslogSend.Create; begin inherited Create; FSock := TUDPBlockSocket.Create; - FSock.CreateSocket; FTargetPort := cSysLogProtocol; FFacility := FCL_Local0; FSeverity := Debug; FTag := ExtractFileName(ParamStr(0)); FMessage := ''; - FIPInterface := cAnyHost; end; destructor TSyslogSend.Destroy; @@ -152,9 +149,9 @@ begin Buf := Buf + Tag + ': ' + FMessage; if Length(Buf) <= 1024 then begin - if FSock.EnableReuse(True) then - Fsock.Bind(FIPInterface, FTargetPort) - else + FSock.EnableReuse(True); + Fsock.Bind(FIPInterface, FTargetPort); + if FSock.LastError <> 0 then FSock.Bind(FIPInterface, cAnyPort); FSock.Connect(FTargetHost, FTargetPort); FSock.SendString(Buf); diff --git a/smtpsend.pas b/smtpsend.pas index 014953e..9de951d 100644 --- a/smtpsend.pas +++ b/smtpsend.pas @@ -1,5 +1,5 @@ {==============================================================================| -| Project : Delphree - Synapse | 003.002.004 | +| Project : Delphree - Synapse | 003.002.008 | |==============================================================================| | Content: SMTP client | |==============================================================================| @@ -42,14 +42,15 @@ | (Found at URL: http://www.ararat.cz/synapse/) | |==============================================================================} -{$WEAKPACKAGEUNIT ON} - unit SMTPsend; interface uses SysUtils, Classes, + {$IFDEF STREAMSEC} + TlsInternalServer, TlsSynaSock, + {$ENDIF} blcksock, SynaUtil, SynaCode; const @@ -58,7 +59,12 @@ const type TSMTPSend = class(TSynaClient) private + {$IFDEF STREAMSEC} + FSock: TSsTCPBlockSocket; + FTLSServer: TCustomTLSInternalServer; + {$ELSE} FSock: TTCPBlockSocket; + {$ENDIF} FResultCode: Integer; FResultString: string; FFullResult: TStringList; @@ -112,9 +118,14 @@ type property EnhCode2: Integer read FEnhCode2; property EnhCode3: Integer read FEnhCode3; property SystemName: string read FSystemName Write FSystemName; - property Sock: TTCPBlockSocket read FSock; property AutoTLS: Boolean read FAutoTLS Write FAutoTLS; property FullSSL: Boolean read FFullSSL Write FFullSSL; +{$IFDEF STREAMSEC} + property Sock: TSsTCPBlockSocket read FSock; + property TLSServer: TCustomTLSInternalServer read FTLSServer write FTLSServer; +{$ELSE} + property Sock: TTCPBlockSocket read FSock; +{$ENDIF} end; function SendToRaw(const MailFrom, MailTo, SMTPHost: string; @@ -131,10 +142,15 @@ begin inherited Create; FFullResult := TStringList.Create; FESMTPcap := TStringList.Create; +{$IFDEF STREAMSEC} + FTLSServer := GlobalTLSInternalServer; + FSock := TSsTCPBlockSocket.Create; + FSock.BlockingRead := True; +{$ELSE} FSock := TTCPBlockSocket.Create; - FSock.CreateSocket; +{$ENDIF} FSock.ConvertLineEnd := true; - FTimeout := 300000; + FTimeout := 60000; FTargetPort := cSmtpProtocol; FUsername := ''; FPassword := ''; @@ -239,11 +255,26 @@ end; function TSMTPSend.Connect: Boolean; begin FSock.CloseSocket; - FSock.CreateSocket; + FSock.Bind(FIPInterface, cAnyPort); +{$IFDEF STREAMSEC} + if FFullSSL then + begin + if assigned(FTLSServer) then + FSock.TLSServer := FTLSServer; + else + begin + result := False; + Exit; + end; + end + else + FSock.TLSServer := nil; +{$ELSE} if FFullSSL then FSock.SSLEnabled := True; - FSock.Bind(FIPInterface, cAnyPort); - FSock.Connect(FTargetHost, FTargetPort); +{$ENDIF} + if FSock.LastError = 0 then + FSock.Connect(FTargetHost, FTargetPort); Result := FSock.LastError = 0; end; @@ -406,8 +437,19 @@ begin FSock.SendString('STARTTLS' + CRLF); if (ReadResult = 220) and (FSock.LastError = 0) then begin +{$IFDEF STREAMSEC} + if (Assigned(FTLSServer) then + begin + Fsock.TLSServer := FTLSServer; + Fsock.Connect('',''); + Result := FSock.LastError = 0; + end + else + Result := False; +{$ELSE} Fsock.SSLDoConnect; Result := FSock.LastError = 0; +{$ENDIF} end; end; end; diff --git a/snmpsend.pas b/snmpsend.pas index 57eda2e..365548d 100644 --- a/snmpsend.pas +++ b/snmpsend.pas @@ -1,5 +1,5 @@ {==============================================================================| -| Project : Delphree - Synapse | 002.006.000 | +| Project : Delphree - Synapse | 002.006.002 | |==============================================================================| | Content: SNMP client | |==============================================================================| @@ -44,7 +44,6 @@ |==============================================================================} {$Q-} -{$WEAKPACKAGEUNIT ON} unit SNMPSend; @@ -308,7 +307,6 @@ begin FQuery.Clear; FReply.Clear; FSock := TUDPBlockSocket.Create; - FSock.CreateSocket; FTimeout := 5000; FTargetPort := cSnmpProtocol; FHostIP := ''; diff --git a/snmptrap.pas b/snmptrap.pas index 5ff2d07..2c49ad9 100644 --- a/snmptrap.pas +++ b/snmptrap.pas @@ -1,5 +1,5 @@ {==============================================================================| -| Project : Delphree - Synapse | 002.003.000 | +| Project : Delphree - Synapse | 002.003.002 | |==============================================================================| | Content: SNMP traps | |==============================================================================| @@ -44,7 +44,6 @@ |==============================================================================} {$Q-} -{$WEAKPACKAGEUNIT ON} unit SNMPTrap; @@ -272,7 +271,6 @@ constructor TTrapSNMP.Create; begin inherited Create; FSock := TUDPBlockSocket.Create; - FSock.CreateSocket; FTrap := TTrapPDU.Create; FTimeout := 5000; FTargetPort := cSnmpTrapProtocol; diff --git a/sntpsend.pas b/sntpsend.pas index fa77dfd..9d23485 100644 --- a/sntpsend.pas +++ b/sntpsend.pas @@ -1,5 +1,5 @@ {==============================================================================| -| Project : Delphree - Synapse | 002.002.001 | +| Project : Delphree - Synapse | 002.002.003 | |==============================================================================| | Content: SNTP client | |==============================================================================| @@ -44,7 +44,6 @@ |==============================================================================} {$Q-} -{$WEAKPACKAGEUNIT ON} unit SNTPsend; @@ -112,7 +111,6 @@ constructor TSNTPSend.Create; begin inherited Create; FSock := TUDPBlockSocket.Create; - FSock.CreateSocket; FTimeout := 5000; FTargetPort := cNtpProtocol; FMaxSyncDiff := 3600; diff --git a/synachar.pas b/synachar.pas index ab96e1f..70d2210 100644 --- a/synachar.pas +++ b/synachar.pas @@ -1,5 +1,5 @@ {==============================================================================| -| Project : Delphree - Synapse | 004.000.003 | +| Project : Delphree - Synapse | 004.000.005 | |==============================================================================| | Content: Charset conversion support | |==============================================================================| @@ -43,7 +43,6 @@ |==============================================================================} {$Q-} -{$WEAKPACKAGEUNIT ON} unit SynaChar; @@ -797,51 +796,71 @@ end; {==============================================================================} procedure ReadMulti(const Value: string; var Index: Integer; mb: Byte; var b1, b2, b3, b4: Byte); -var - b: array[0..3] of Byte; - n: Integer; - s: string; -begin - b[0] := 0; - b[1] := 0; - b[2] := 0; - b[3] := 0; +Begin b1 := 0; b2 := 0; b3 := 0; b4 := 0; - if length(Value) < (Index + mb - 1) then + if Index < 0 then + Index := 1; + if mb > 4 then + mb := 1; + if (Index + mb - 1) <= Length(Value) then begin - Inc(index, mb); - Exit; - end; - s := ''; - for n := 1 to mb do - begin - s := Value[Index] + s; - Inc(Index); - end; - for n := 1 to mb do - b[n - 1] := Ord(s[n]); - b1 := b[0]; - b2 := b[1]; - b3 := b[2]; - b4 := b[3]; -end; + Case mb Of + 1: + b1 := Ord(Value[Index]); + 2: + Begin + b1 := Ord(Value[Index]); + b2 := Ord(Value[Index + 1]); + End; + 3: + Begin + b1 := Ord(Value[Index]); + b2 := Ord(Value[Index + 1]); + b3 := Ord(Value[Index + 2]); + End; + 4: + Begin + b1 := Ord(Value[Index]); + b2 := Ord(Value[Index + 1]); + b3 := Ord(Value[Index + 2]); + b4 := Ord(Value[Index + 3]); + End; + end; + Inc(Index, mb); + End; +End; {==============================================================================} function WriteMulti(b1, b2, b3, b4: Byte; mb: Byte): string; -var - b: array[0..3] of Byte; - n: Integer; begin - Result := ''; - b[0] := b1; - b[1] := b2; - b[2] := b3; - b[3] := b4; - for n := 1 to mb do - Result := Char(b[n - 1]) + Result; + if mb > 4 then + mb := 1; + SetLength(Result, mb); + case mb Of + 1: + Result[1] := Char(b1); + 2: + begin + Result[1] := Char(b1); + Result[2] := Char(b2); + end; + 3: + begin + Result[1] := Char(b1); + Result[2] := Char(b2); + Result[3] := Char(b3); + end; + 4: + begin + Result[1] := Char(b1); + Result[2] := Char(b2); + Result[3] := Char(b3); + Result[4] := Char(b4); + end; + end; end; {==============================================================================} diff --git a/synacode.pas b/synacode.pas index 0e94174..f9b0928 100644 --- a/synacode.pas +++ b/synacode.pas @@ -1,5 +1,5 @@ {==============================================================================| -| Project : Delphree - Synapse | 001.006.001 | +| Project : Delphree - Synapse | 001.007.001 | |==============================================================================| | Content: Coding and decoding support | |==============================================================================| @@ -43,7 +43,6 @@ |==============================================================================} {$Q-} -{$WEAKPACKAGEUNIT ON} unit SynaCode; @@ -115,6 +114,7 @@ function EncodeBase64(const Value: string): string; function DecodeUU(const Value: string): string; function EncodeUU(const Value: string): string; function DecodeXX(const Value: string): string; +function DecodeYEnc(const Value: string): string; function UpdateCrc32(Value: Byte; Crc32: Integer): Integer; function Crc32(const Value: string): Integer; function UpdateCrc16(Value: Byte; Crc16: Word): Word; @@ -559,6 +559,30 @@ end; {==============================================================================} +function DecodeYEnc(const Value: string): string; +var + C : Byte; + i: integer; +begin + Result := ''; + i := 1; + while i <= Length(Value) do + begin + c := Ord(Value[i]); + Inc(i); + if c = Ord('=') then + begin + c := Ord(Value[i]); + Inc(i); + Dec(c, 64); + end; + Dec(C, 42); + Result := Result + Char(C); + end; +end; + +{==============================================================================} + function UpdateCrc32(Value: Byte; Crc32: Integer): Integer; begin Result := ((Crc32 shr 8) and Integer($00FFFFFF)) xor diff --git a/synamisc.pas b/synamisc.pas index d426541..42ce6fc 100644 --- a/synamisc.pas +++ b/synamisc.pas @@ -1,5 +1,5 @@ {==============================================================================| -| Project : Delphree - Synapse | 001.000.004 | +| Project : Delphree - Synapse | 001.000.006 | |==============================================================================| | Content: misc. procedures and functions | |==============================================================================| @@ -48,6 +48,14 @@ unit SynaMisc; interface +{$IFDEF VER125} + {$DEFINE BCB} +{$ENDIF} +{$IFDEF BCB} + {$ObjExportAll On} + {$HPPEMIT '#pragma comment( lib , "wininet.lib" )'} +{$ENDIF} + uses SynaUtil, blcksock, SysUtils, Classes, {$IFDEF LINUX} diff --git a/synassl.pas b/synassl.pas index d0c7927..2662475 100644 --- a/synassl.pas +++ b/synassl.pas @@ -1,5 +1,5 @@ {==============================================================================| -| Project : Delphree - Synapse | 001.007.000 | +| Project : Delphree - Synapse | 001.007.001 | |==============================================================================| | Content: SSL support | |==============================================================================| @@ -47,6 +47,14 @@ Special thanks to Gregor Ibic for good inspiration about SSL programming. } +{$IFDEF VER125} + {$DEFINE BCB} +{$ENDIF} +{$IFDEF BCB} + {$ObjExportAll On} + (*$HPPEMIT 'namespace Synassl { using System::Shortint; }' *) +{$ENDIF} + unit SynaSSL; interface diff --git a/synautil.pas b/synautil.pas index 019e185..d409b6a 100644 --- a/synautil.pas +++ b/synautil.pas @@ -1,5 +1,5 @@ {==============================================================================| -| Project : Delphree - Synapse | 003.003.000 | +| Project : Delphree - Synapse | 003.005.001 | |==============================================================================| | Content: support procedures and functions | |==============================================================================| @@ -45,6 +45,7 @@ |==============================================================================} {$Q-} +{$R-} unit SynaUtil; @@ -70,11 +71,12 @@ function GetDateMDYFromStr(Value: string): TDateTime; function DecodeRfcDateTime(Value: string): TDateTime; function GetUTTime: TDateTime; function SetUTTime(Newdt: TDateTime): Boolean; -function GetTick: Cardinal; +function GetTick: ULong; +function TickDelta(TickOld, TickNew: ULong): ULong; function CodeInt(Value: Word): string; function DecodeInt(const Value: string; Index: Integer): Word; function IsIP(const Value: string): Boolean; -function ReverseIP(Value: string): string; +function IsIP6(const Value: string): Boolean; function IPToID(Host: string): string; procedure Dump(const Buffer, DumpFile: string); procedure DumpEx(const Buffer, DumpFile: string); @@ -479,7 +481,7 @@ end; {==============================================================================} {$IFDEF LINUX} -function GetTick: Cardinal; +function GetTick: ULong; var Stamp: TTimeStamp; begin @@ -487,7 +489,7 @@ begin Result := Stamp.Time; end; {$ELSE} -function GetTick: Cardinal; +function GetTick: ULong; begin Result := Windows.GetTickCount; end; @@ -495,6 +497,27 @@ end; {==============================================================================} +function TickDelta(TickOld, TickNew: ULong): ULong; +begin +//if DWord is signed type (older Deplhi), +// then it not work properly on differencies larger then maxint! + Result := 0; + if TickOld <> TickNew then + begin + if TickNew < TickOld then + begin + TickNew := TickNew + ULong(MaxInt) + 1; + TickOld := TickOld + ULong(MaxInt) + 1; + end; + Result := TickNew - TickOld; + if TickNew < TickOld then + if Result > 0 then + Result := 0 - Result; + end; +end; + +{==============================================================================} + function CodeInt(Value: Word): string; begin Result := Chr(Hi(Value)) + Chr(Lo(Value)) @@ -522,7 +545,6 @@ end; function IsIP(const Value: string): Boolean; var TempIP: string; - function ByteIsOk(const Value: string): Boolean; var x, n: integer; @@ -539,7 +561,6 @@ var Break; end; end; - begin TempIP := Value; Result := False; @@ -555,19 +576,47 @@ end; {==============================================================================} -function ReverseIP(Value: string): string; +function IsIP6(const Value: string): Boolean; var - x: Integer; + TempIP: string; + s,t: string; + x: integer; + partcount: integer; + zerocount: integer; + First: Boolean; begin - Result := ''; - repeat - x := LastDelimiter('.', Value); - Result := Result + '.' + Copy(Value, x + 1, Length(Value) - x); - Delete(Value, x, Length(Value) - x + 1); - until x < 1; - if Length(Result) > 0 then - if Result[1] = '.' then - Delete(Result, 1, 1); + TempIP := Value; + Result := False; + partcount := 0; + zerocount := 0; + First := True; + while tempIP <> '' do + begin + s := fetch(TempIP, ':'); + if not(First) and (s = '') then + Inc(zerocount); + First := False; + if zerocount > 1 then + break; + Inc(partCount); + if s = '' then + Continue; + if partCount > 8 then + break; + if tempIP = '' then + begin + t := SeparateRight(s, '%'); + s := SeparateLeft(s, '%'); + x := StrToIntDef('$' + t, -1); + if (x < 0) or (x > $ffff) then + break; + end; + x := StrToIntDef('$' + s, -1); + if (x < 0) or (x > $ffff) then + break; + if tempIP = '' then + Result := True; + end; end; {==============================================================================} @@ -878,14 +927,25 @@ begin s1 := sURL; s2 := ''; end; - x := Pos(':', s1); - if x > 0 then + if Pos('[', s1) = 1 then begin - Host := SeparateLeft(s1, ':'); - Port := SeparateRight(s1, ':'); + Host := Separateleft(s1, ']'); + Delete(Host, 1, 1); + s1 := SeparateRight(s1, ']'); + if Pos(':', s1) = 1 then + Port := SeparateRight(s1, ':'); end else - Host := s1; + begin + x := Pos(':', s1); + if x > 0 then + begin + Host := SeparateLeft(s1, ':'); + Port := SeparateRight(s1, ':'); + end + else + Host := s1; + end; Result := '/' + s2; x := Pos('?', s2); if x > 0 then diff --git a/synsock.pas b/synsock.pas index c63889c..93898a6 100644 --- a/synsock.pas +++ b/synsock.pas @@ -1,5 +1,5 @@ {==============================================================================| -| Project : Delphree - Synapse | 002.002.000 | +| Project : Delphree - Synapse | 003.001.003 | |==============================================================================| | Content: Socket Independent Platform Layer | |==============================================================================| @@ -42,24 +42,715 @@ | (Found at URL: http://www.ararat.cz/synapse/) | |==============================================================================} -{ Comment next line if you need dynamic loading of winsock under Windows - or any another DLL stack by CreateAlternate constructor of TBlockSocket Class. - if next line stay uncommented, is used static mapping. This is fater method. - Under Linx is always used static maping to Libc. } -{$DEFINE STATICWINSOCK} +{$IFNDEF LINUX} +//{$DEFINE WINSOCK1} +{Note about define WINSOCK1: +If you activate this compiler directive, then socket interface level 1.1 is +used instead default level 2.2. Level 2.2 is not available on old W95, however +you can install update. + +On Linux is level 2.2 always used! +} +{$ENDIF} + +//{$DEFINE FORCEOLDAPI} +{Note about define FORCEOLDAPI: +If you activate this compiler directive, then is allways used old socket API +for name resolution. If you leave this directive inactive, then when new API +is used, when running system allows it. + +For IPv6 support you must have new API! +} + +{$IFDEF VER125} + {$DEFINE BCB} +{$ENDIF} +{$IFDEF BCB} + {$ObjExportAll On} + (*$HPPEMIT '/* EDE 2003-02-19 */' *) + (*$HPPEMIT 'namespace Synsock { using System::Shortint; }' *) + (*$HPPEMIT '#undef h_addr' *) + (*$HPPEMIT '#undef IOCPARM_MASK' *) + (*$HPPEMIT '#undef FD_SETSIZE' *) + (*$HPPEMIT '#undef IOC_VOID' *) + (*$HPPEMIT '#undef IOC_OUT' *) + (*$HPPEMIT '#undef IOC_IN' *) + (*$HPPEMIT '#undef IOC_INOUT' *) + (*$HPPEMIT '#undef FIONREAD' *) + (*$HPPEMIT '#undef FIONBIO' *) + (*$HPPEMIT '#undef FIOASYNC' *) + (*$HPPEMIT '#undef IPPROTO_IP' *) + (*$HPPEMIT '#undef IPPROTO_ICMP' *) + (*$HPPEMIT '#undef IPPROTO_IGMP' *) + (*$HPPEMIT '#undef IPPROTO_TCP' *) + (*$HPPEMIT '#undef IPPROTO_UDP' *) + (*$HPPEMIT '#undef IPPROTO_RAW' *) + (*$HPPEMIT '#undef IPPROTO_MAX' *) + (*$HPPEMIT '#undef INADDR_ANY' *) + (*$HPPEMIT '#undef INADDR_LOOPBACK' *) + (*$HPPEMIT '#undef INADDR_BROADCAST' *) + (*$HPPEMIT '#undef INADDR_NONE' *) + (*$HPPEMIT '#undef INVALID_SOCKET' *) + (*$HPPEMIT '#undef SOCKET_ERROR' *) + (*$HPPEMIT '#undef WSADESCRIPTION_LEN' *) + (*$HPPEMIT '#undef WSASYS_STATUS_LEN' *) + (*$HPPEMIT '#undef IP_OPTIONS' *) + (*$HPPEMIT '#undef IP_TOS' *) + (*$HPPEMIT '#undef IP_TTL' *) + (*$HPPEMIT '#undef IP_MULTICAST_IF' *) + (*$HPPEMIT '#undef IP_MULTICAST_TTL' *) + (*$HPPEMIT '#undef IP_MULTICAST_LOOP' *) + (*$HPPEMIT '#undef IP_ADD_MEMBERSHIP' *) + (*$HPPEMIT '#undef IP_DROP_MEMBERSHIP' *) + (*$HPPEMIT '#undef IP_DONTFRAGMENT' *) + (*$HPPEMIT '#undef IP_DEFAULT_MULTICAST_TTL' *) + (*$HPPEMIT '#undef IP_DEFAULT_MULTICAST_LOOP' *) + (*$HPPEMIT '#undef IP_MAX_MEMBERSHIPS' *) + (*$HPPEMIT '#undef SOL_SOCKET' *) + (*$HPPEMIT '#undef SO_DEBUG' *) + (*$HPPEMIT '#undef SO_ACCEPTCONN' *) + (*$HPPEMIT '#undef SO_REUSEADDR' *) + (*$HPPEMIT '#undef SO_KEEPALIVE' *) + (*$HPPEMIT '#undef SO_DONTROUTE' *) + (*$HPPEMIT '#undef SO_BROADCAST' *) + (*$HPPEMIT '#undef SO_USELOOPBACK' *) + (*$HPPEMIT '#undef SO_LINGER' *) + (*$HPPEMIT '#undef SO_OOBINLINE' *) + (*$HPPEMIT '#undef SO_DONTLINGER' *) + (*$HPPEMIT '#undef SO_SNDBUF' *) + (*$HPPEMIT '#undef SO_RCVBUF' *) + (*$HPPEMIT '#undef SO_SNDLOWAT' *) + (*$HPPEMIT '#undef SO_RCVLOWAT' *) + (*$HPPEMIT '#undef SO_SNDTIMEO' *) + (*$HPPEMIT '#undef SO_RCVTIMEO' *) + (*$HPPEMIT '#undef SO_ERROR' *) + (*$HPPEMIT '#undef SO_OPENTYPE' *) + (*$HPPEMIT '#undef SO_SYNCHRONOUS_ALERT' *) + (*$HPPEMIT '#undef SO_SYNCHRONOUS_NONALERT' *) + (*$HPPEMIT '#undef SO_MAXDG' *) + (*$HPPEMIT '#undef SO_MAXPATHDG' *) + (*$HPPEMIT '#undef SO_UPDATE_ACCEPT_CONTEXT' *) + (*$HPPEMIT '#undef SO_CONNECT_TIME' *) + (*$HPPEMIT '#undef SO_TYPE' *) + (*$HPPEMIT '#undef SOCK_STREAM' *) + (*$HPPEMIT '#undef SOCK_DGRAM' *) + (*$HPPEMIT '#undef SOCK_RAW' *) + (*$HPPEMIT '#undef SOCK_RDM' *) + (*$HPPEMIT '#undef SOCK_SEQPACKET' *) + (*$HPPEMIT '#undef TCP_NODELAY' *) + (*$HPPEMIT '#undef AF_UNSPEC' *) + (*$HPPEMIT '#undef SOMAXCONN' *) + (*$HPPEMIT '#undef AF_INET' *) + (*$HPPEMIT '#undef AF_MAX' *) + (*$HPPEMIT '#undef PF_UNSPEC' *) + (*$HPPEMIT '#undef PF_INET' *) + (*$HPPEMIT '#undef PF_MAX' *) + (*$HPPEMIT '#undef MSG_OOB' *) + (*$HPPEMIT '#undef MSG_PEEK' *) + (*$HPPEMIT '#undef WSABASEERR' *) + (*$HPPEMIT '#undef WSAEINTR' *) + (*$HPPEMIT '#undef WSAEBADF' *) + (*$HPPEMIT '#undef WSAEACCES' *) + (*$HPPEMIT '#undef WSAEFAULT' *) + (*$HPPEMIT '#undef WSAEINVAL' *) + (*$HPPEMIT '#undef WSAEMFILE' *) + (*$HPPEMIT '#undef WSAEWOULDBLOCK' *) + (*$HPPEMIT '#undef WSAEINPROGRESS' *) + (*$HPPEMIT '#undef WSAEALREADY' *) + (*$HPPEMIT '#undef WSAENOTSOCK' *) + (*$HPPEMIT '#undef WSAEDESTADDRREQ' *) + (*$HPPEMIT '#undef WSAEMSGSIZE' *) + (*$HPPEMIT '#undef WSAEPROTOTYPE' *) + (*$HPPEMIT '#undef WSAENOPROTOOPT' *) + (*$HPPEMIT '#undef WSAEPROTONOSUPPORT' *) + (*$HPPEMIT '#undef WSAESOCKTNOSUPPORT' *) + (*$HPPEMIT '#undef WSAEOPNOTSUPP' *) + (*$HPPEMIT '#undef WSAEPFNOSUPPORT' *) + (*$HPPEMIT '#undef WSAEAFNOSUPPORT' *) + (*$HPPEMIT '#undef WSAEADDRINUSE' *) + (*$HPPEMIT '#undef WSAEADDRNOTAVAIL' *) + (*$HPPEMIT '#undef WSAENETDOWN' *) + (*$HPPEMIT '#undef WSAENETUNREACH' *) + (*$HPPEMIT '#undef WSAENETRESET' *) + (*$HPPEMIT '#undef WSAECONNABORTED' *) + (*$HPPEMIT '#undef WSAECONNRESET' *) + (*$HPPEMIT '#undef WSAENOBUFS' *) + (*$HPPEMIT '#undef WSAEISCONN' *) + (*$HPPEMIT '#undef WSAENOTCONN' *) + (*$HPPEMIT '#undef WSAESHUTDOWN' *) + (*$HPPEMIT '#undef WSAETOOMANYREFS' *) + (*$HPPEMIT '#undef WSAETIMEDOUT' *) + (*$HPPEMIT '#undef WSAECONNREFUSED' *) + (*$HPPEMIT '#undef WSAELOOP' *) + (*$HPPEMIT '#undef WSAENAMETOOLONG' *) + (*$HPPEMIT '#undef WSAEHOSTDOWN' *) + (*$HPPEMIT '#undef WSAEHOSTUNREACH' *) + (*$HPPEMIT '#undef WSAENOTEMPTY' *) + (*$HPPEMIT '#undef WSAEPROCLIM' *) + (*$HPPEMIT '#undef WSAEUSERS' *) + (*$HPPEMIT '#undef WSAEDQUOT' *) + (*$HPPEMIT '#undef WSAESTALE' *) + (*$HPPEMIT '#undef WSAEREMOTE' *) + (*$HPPEMIT '#undef WSASYSNOTREADY' *) + (*$HPPEMIT '#undef WSAVERNOTSUPPORTED' *) + (*$HPPEMIT '#undef WSANOTINITIALISED' *) + (*$HPPEMIT '#undef WSAEDISCON' *) + (*$HPPEMIT '#undef WSAENOMORE' *) + (*$HPPEMIT '#undef WSAECANCELLED' *) + (*$HPPEMIT '#undef WSAEEINVALIDPROCTABLE' *) + (*$HPPEMIT '#undef WSAEINVALIDPROVIDER' *) + (*$HPPEMIT '#undef WSAEPROVIDERFAILEDINIT' *) + (*$HPPEMIT '#undef WSASYSCALLFAILURE' *) + (*$HPPEMIT '#undef WSASERVICE_NOT_FOUND' *) + (*$HPPEMIT '#undef WSATYPE_NOT_FOUND' *) + (*$HPPEMIT '#undef WSA_E_NO_MORE' *) + (*$HPPEMIT '#undef WSA_E_CANCELLED' *) + (*$HPPEMIT '#undef WSAEREFUSED' *) + (*$HPPEMIT '#undef WSAHOST_NOT_FOUND' *) + (*$HPPEMIT '#undef HOST_NOT_FOUND' *) + (*$HPPEMIT '#undef WSATRY_AGAIN' *) + (*$HPPEMIT '#undef TRY_AGAIN' *) + (*$HPPEMIT '#undef WSANO_RECOVERY' *) + (*$HPPEMIT '#undef NO_RECOVERY' *) + (*$HPPEMIT '#undef WSANO_DATA' *) + (*$HPPEMIT '#undef NO_DATA' *) + (*$HPPEMIT '#undef WSANO_ADDRESS' *) + (*$HPPEMIT '#undef ENAMETOOLONG' *) + (*$HPPEMIT '#undef ENOTEMPTY' *) + (*$HPPEMIT '#undef FD_CLR' *) + (*$HPPEMIT '#undef FD_ISSET' *) + (*$HPPEMIT '#undef FD_SET' *) + (*$HPPEMIT '#undef FD_ZERO' *) + (*$HPPEMIT '#undef NO_ADDRESS' *) +{$ENDIF} + unit synsock; +{$MINENUMSIZE 4} + interface uses - SyncObjs, + SyncObjs, SysUtils, {$IFDEF LINUX} - Libc, KernelIoctl; + Libc; {$ELSE} - Windows, WinSock; + Windows; {$ENDIF} +function InitSocketInterface(stack: string): Boolean; +function DestroySocketInterface: Boolean; + +const +{$IFDEF WINSOCK1} + WinsockLevel = $0101; +{$ELSE} + WinsockLevel = $0202; +{$ENDIF} + +type + u_char = Char; + u_short = Word; + u_int = Integer; + u_long = Longint; + pu_long = ^u_long; + pu_short = ^u_short; + TSocket = u_int; + +{$IFDEF LINUX} +type + DWORD = Integer; + __fd_mask = LongWord; +const + __FD_SETSIZE = 1024; + __NFDBITS = 8 * sizeof(__fd_mask); +type + __fd_set = {packed} record + fds_bits: packed array[0..(__FD_SETSIZE div __NFDBITS)-1] of __fd_mask; + end; + TFDSet = __fd_set; + PFDSet = ^TFDSet; + +const + FIONREAD = $541B; + FIONBIO = $5421; + FIOASYNC = $5452; + +{$ELSE} +const + FD_SETSIZE = 64; +type + PFDSet = ^TFDSet; + TFDSet = packed record + fd_count: u_int; + fd_array: array[0..FD_SETSIZE-1] of TSocket; + end; + +const + IOCPARM_MASK = $7f; + IOC_VOID = $20000000; + IOC_OUT = $40000000; + IOC_IN = $80000000; + IOC_INOUT = (IOC_IN or IOC_OUT); + FIONREAD = IOC_OUT or { get # bytes to read } + ((Longint(SizeOf(Longint)) and IOCPARM_MASK) shl 16) or + (Longint(Byte('f')) shl 8) or 127; + FIONBIO = IOC_IN or { set/clear non-blocking i/o } + ((Longint(SizeOf(Longint)) and IOCPARM_MASK) shl 16) or + (Longint(Byte('f')) shl 8) or 126; + FIOASYNC = IOC_IN or { set/clear async i/o } + ((Longint(SizeOf(Longint)) and IOCPARM_MASK) shl 16) or + (Longint(Byte('f')) shl 8) or 125; + +{$ENDIF} + +type + PTimeVal = ^TTimeVal; + TTimeVal = packed record + tv_sec: Longint; + tv_usec: Longint; + end; + +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_RAW = 255; + IPPROTO_MAX = 256; + +type + SunB = packed record + s_b1, s_b2, s_b3, s_b4: u_char; + end; + + SunW = packed record + s_w1, s_w2: u_short; + end; + + PInAddr = ^TInAddr; + TInAddr = packed record + case integer of + 0: (S_un_b: SunB); + 1: (S_un_w: SunW); + 2: (S_addr: u_long); + end; + + PSockAddrIn = ^TSockAddrIn; + TSockAddrIn = packed record + case Integer of + 0: (sin_family: u_short; + sin_port: u_short; + sin_addr: TInAddr; + sin_zero: array[0..7] of Char); + 1: (sa_family: u_short; + sa_data: array[0..13] of Char) + end; + + TIP_mreq = record + imr_multiaddr: TInAddr; { IP multicast address of group } + imr_interface: TInAddr; { local IP address of interface } + end; + + SunB6 = packed record + s_b1, s_b2, s_b3, s_b4, + s_b5, s_b6, s_b7, s_b8, + s_b9, s_b10, s_b11, s_b12, + s_b13, s_b14, s_b15, s_b16: u_char; + end; + + SunW6 = packed record + s_w1, s_w2, s_w3, s_w4, + s_w5, s_w6, s_w7, s_w8: u_short; + end; + + SunDW6 = packed record + s_dw1, s_dw2, s_dw3, s_dw4: longint; + end; + + S6_Bytes = SunB6; + S6_Words = SunW6; + S6_DWords = SunDW6; + S6_Addr = SunB6; + + PInAddr6 = ^TInAddr6; + TInAddr6 = packed record + case integer of + 0: (S_un_b: SunB6); + 1: (S_un_w: SunW6); + 2: (S_un_dw: SunDW6); + end; + + PSockAddrIn6 = ^TSockAddrIn6; + TSockAddrIn6 = packed record + sin6_family: u_short; // AF_INET6 + sin6_port: u_short; // Transport level port number + sin6_flowinfo: u_long; // IPv6 flow information + sin6_addr: TInAddr6; // IPv6 address + sin6_scope_id: u_long; // Scope Id: IF number for link-local + // SITE id for site-local + end; + + TIPv6_mreq = record + ipv6mr_multiaddr: TInAddr6; // IPv6 multicast address. + ipv6mr_interface: u_long; // Interface index. + padding: u_long; + end; + + +{$IFDEF LINUX} + hostent = record + h_name: PChar; + h_aliases: PPChar; + h_addrtype: Integer; + h_length: Cardinal; + case Byte of + 0: (h_addr_list: PPChar); + 1: (h_addr: PPChar); + end; + + PNetEnt = ^TNetEnt; + TNetEnt = record + n_name: PChar; + n_aliases: PPChar; + n_addrtype: Integer; + n_net: uint32_t; + end; + + PServEnt = ^TServEnt; + TServEnt = record + s_name: PChar; + s_aliases: PPChar; + s_port: Integer; + s_proto: PChar; + end; + + PProtoEnt = ^TProtoEnt; + TProtoEnt = record + p_name: PChar; + p_aliases: ^PChar; + p_proto: u_short; + end; + +{$ELSE} + PHostEnt = ^THostEnt; + THostEnt = packed record + h_name: PChar; + h_aliases: ^PChar; + h_addrtype: Smallint; + h_length: Smallint; + case integer of + 0: (h_addr_list: ^PChar); + 1: (h_addr: ^PInAddr); + end; + + PNetEnt = ^TNetEnt; + TNetEnt = packed record + n_name: PChar; + n_aliases: ^PChar; + n_addrtype: Smallint; + n_net: u_long; + end; + + PServEnt = ^TServEnt; + TServEnt = packed record + s_name: PChar; + s_aliases: ^PChar; + s_port: Smallint; + s_proto: PChar; + end; + + PProtoEnt = ^TProtoEnt; + TProtoEnt = packed record + p_name: PChar; + p_aliases: ^Pchar; + p_proto: Smallint; + end; +{$ENDIF} + +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; + + 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; + +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; + +{=============================================================================} +{$IFDEF LINUX} +Const + IP_TOS = 1; { int; IP type of service and precedence. } + IP_TTL = 2; { int; IP time to live. } + IP_HDRINCL = 3; { int; Header is included with data. } + IP_OPTIONS = 4; { ip_opts; IP per-packet options. } + IP_ROUTER_ALERT = 5; { bool } + IP_RECVOPTS = 6; { bool } + IP_RETOPTS = 7; { bool } + IP_PKTINFO = 8; { bool } + IP_PKTOPTIONS = 9; + IP_PMTUDISC = 10; { obsolete name? } + IP_MTU_DISCOVER = 10; { int; see below } + IP_RECVERR = 11; { bool } + IP_RECVTTL = 12; { bool } + IP_RECVTOS = 13; { bool } + IP_MULTICAST_IF = 32; { in_addr; set/get IP multicast i/f } + IP_MULTICAST_TTL = 33; { u_char; set/get IP multicast ttl } + IP_MULTICAST_LOOP = 34; { i_char; set/get IP multicast loopback } + IP_ADD_MEMBERSHIP = 35; { ip_mreq; add an IP group membership } + IP_DROP_MEMBERSHIP = 36; { ip_mreq; drop an IP group membership } + + SOL_SOCKET = 1; + + SO_DEBUG = 1; + SO_REUSEADDR = 2; + SO_TYPE = 3; + SO_ERROR = 4; + SO_DONTROUTE = 5; + SO_BROADCAST = 6; + SO_SNDBUF = 7; + SO_RCVBUF = 8; + SO_KEEPALIVE = 9; + SO_OOBINLINE = 10; + SO_NO_CHECK = 11; + SO_PRIORITY = 12; + SO_LINGER = 13; + SO_BSDCOMPAT = 14; + SO_REUSEPORT = 15; + SO_PASSCRED = 16; + SO_PEERCRED = 17; + SO_RCVLOWAT = 18; + SO_SNDLOWAT = 19; + SO_RCVTIMEO = 20; + SO_SNDTIMEO = 21; +{ Security levels - as per NRL IPv6 - don't actually do anything } + SO_SECURITY_AUTHENTICATION = 22; + SO_SECURITY_ENCRYPTION_TRANSPORT = 23; + SO_SECURITY_ENCRYPTION_NETWORK = 24; + SO_BINDTODEVICE = 25; +{ Socket filtering } + SO_ATTACH_FILTER = 26; + SO_DETACH_FILTER = 27; + + SOMAXCONN = 128; + + IPV6_UNICAST_HOPS = 16; + IPV6_MULTICAST_IF = 17; + IPV6_MULTICAST_HOPS = 18; + IPV6_MULTICAST_LOOP = 19; + IPV6_JOIN_GROUP = 20; + IPV6_LEAVE_GROUP = 21; + + MSG_NOSIGNAL = $4000; // Do not generate SIGPIPE. + +{=============================================================================} +{$ELSE} +Const + {$IFDEF WINSOCK1} + IP_OPTIONS = 1; + IP_MULTICAST_IF = 2; { set/get IP multicast interface } + IP_MULTICAST_TTL = 3; { set/get IP multicast timetolive } + IP_MULTICAST_LOOP = 4; { set/get IP multicast loopback } + IP_ADD_MEMBERSHIP = 5; { add an IP group membership } + IP_DROP_MEMBERSHIP = 6; { drop an IP group membership } + IP_TTL = 7; { set/get IP Time To Live } + IP_TOS = 8; { set/get IP Type Of Service } + IP_DONTFRAGMENT = 9; { set/get IP Don't Fragment flag } + {$ELSE} + IP_OPTIONS = 1; + IP_HDRINCL = 2; + IP_TOS = 3; { set/get IP Type Of Service } + IP_TTL = 4; { set/get IP Time To Live } + IP_MULTICAST_IF = 9; { set/get IP multicast interface } + IP_MULTICAST_TTL = 10; { set/get IP multicast timetolive } + IP_MULTICAST_LOOP = 11; { set/get IP multicast loopback } + IP_ADD_MEMBERSHIP = 12; { add an IP group membership } + IP_DROP_MEMBERSHIP = 13; { drop an IP group membership } + IP_DONTFRAGMENT = 14; { set/get IP Don't Fragment flag } + {$ENDIF} + + IP_DEFAULT_MULTICAST_TTL = 1; { normally limit m'casts to 1 hop } + IP_DEFAULT_MULTICAST_LOOP = 1; { normally hear sends if a member } + IP_MAX_MEMBERSHIPS = 20; { per socket; must fit in one mbuf } + + SOL_SOCKET = $ffff; {options for socket level } +{ Option flags per-socket. } + SO_DEBUG = $0001; { turn on debugging info recording } + SO_ACCEPTCONN = $0002; { socket has had listen() } + SO_REUSEADDR = $0004; { allow local address reuse } + SO_KEEPALIVE = $0008; { keep connections alive } + SO_DONTROUTE = $0010; { just use interface addresses } + SO_BROADCAST = $0020; { permit sending of broadcast msgs } + SO_USELOOPBACK = $0040; { bypass hardware when possible } + SO_LINGER = $0080; { linger on close if data present } + SO_OOBINLINE = $0100; { leave received OOB data in line } + SO_DONTLINGER = $ff7f; +{ Additional options. } + SO_SNDBUF = $1001; { send buffer size } + SO_RCVBUF = $1002; { receive buffer size } + SO_SNDLOWAT = $1003; { send low-water mark } + SO_RCVLOWAT = $1004; { receive low-water mark } + SO_SNDTIMEO = $1005; { send timeout } + SO_RCVTIMEO = $1006; { receive timeout } + SO_ERROR = $1007; { get error status and clear } + SO_TYPE = $1008; { get socket type } +{ WinSock 2 extension -- new options } + SO_GROUP_ID = $2001; { ID of a socket group} + SO_GROUP_PRIORITY = $2002; { the relative priority within a group} + SO_MAX_MSG_SIZE = $2003; { maximum message size } + SO_PROTOCOL_INFOA = $2004; { WSAPROTOCOL_INFOA structure } + SO_PROTOCOL_INFOW = $2005; { WSAPROTOCOL_INFOW structure } + SO_PROTOCOL_INFO = SO_PROTOCOL_INFOA; + PVD_CONFIG = $3001; {configuration info for service provider } +{ Option for opening sockets for synchronous access. } + SO_OPENTYPE = $7008; + SO_SYNCHRONOUS_ALERT = $10; + SO_SYNCHRONOUS_NONALERT = $20; +{ Other NT-specific options. } + SO_MAXDG = $7009; + SO_MAXPATHDG = $700A; + SO_UPDATE_ACCEPT_CONTEXT = $700B; + SO_CONNECT_TIME = $700C; + + SOMAXCONN = $7fffffff; + + IPV6_UNICAST_HOPS = 8; // ??? + IPV6_MULTICAST_IF = 9; // set/get IP multicast i/f + IPV6_MULTICAST_HOPS = 10; // set/get IP multicast ttl + IPV6_MULTICAST_LOOP = 11; // set/get IP multicast loopback + IPV6_JOIN_GROUP = 12; // add an IP group membership + IPV6_LEAVE_GROUP = 13; // drop an IP group membership + + MSG_NOSIGNAL = 0; + +{$ENDIF} +{=============================================================================} + +const + 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 } + +{ TCP options. } + TCP_NODELAY = $0001; + +{ Address families. } + + AF_UNSPEC = 0; { unspecified } + AF_INET = 2; { internetwork: UDP, TCP, etc. } +{$IFDEF LINUX} + AF_INET6 = 10; { Internetwork Version 6 } +{$ELSE} + AF_INET6 = 23; { Internetwork Version 6 } +{$ENDIF} + AF_MAX = 24; + +{ Protocol families, same as address families for now. } + PF_UNSPEC = AF_UNSPEC; + PF_INET = AF_INET; + PF_INET6 = AF_INET6; + PF_MAX = AF_MAX; + +type + { Structure used by kernel to store most addresses. } + + PSockAddr = ^TSockAddr; + TSockAddr = TSockAddrIn; + + { Structure used by kernel to pass protocol information in raw sockets. } + PSockProto = ^TSockProto; + TSockProto = packed record + sp_family: u_short; + sp_protocol: u_short; + end; + +type + PAddrInfo = ^TAddrInfo; + TAddrInfo = record + ai_flags: integer; // AI_PASSIVE, AI_CANONNAME, AI_NUMERICHOST. + ai_family: integer; // PF_xxx. + ai_socktype: integer; // SOCK_xxx. + ai_protocol: integer; // 0 or IPPROTO_xxx for IPv4 and IPv6. + ai_addrlen: u_int; // Length of ai_addr. + {$IFDEF LINUX} // broken definition in LIBC??? :-O + ai_addr: PSockAddr; // Binary address. + ai_canonname: PChar; // Canonical name for nodename. + {$ELSE} + ai_canonname: PChar; // Canonical name for nodename. + ai_addr: PSockAddr; // Binary address. + {$ENDIF} + ai_next: PAddrInfo; // Next structure in linked list. + end; + +const + // Flags used in "hints" argument to getaddrinfo(). + AI_PASSIVE = $1; // Socket address will be used in bind() call. + AI_CANONNAME = $2; // Return canonical name in first ai_canonname. + AI_NUMERICHOST = $4; // Nodename must be a numeric address string. + + // getnameinfo constants + NI_MAXHOST = 1025; + NI_MAXSERV = 32; + NI_NOFQDN = $1; + NI_NUMERICHOST = $2; + NI_NAMEREQD = $4; + NI_NUMERICSERV = $8; + NI_DGRAM = $10; + +type +{ Structure used for manipulating linger option. } + PLinger = ^TLinger; + TLinger = packed record + l_onoff: u_short; + l_linger: u_short; + end; + +const + +{ Define constant based on rfc883, used by gethostbyxxxx() calls. } + + MSG_OOB = $01; // Process out-of-band data. + MSG_PEEK = $02; // Peek at incoming messages. + +procedure FD_CLR(Socket: TSocket; var FDSet: TFDSet); +function FD_ISSET(Socket: TSocket; var FDSet: TFDSet): Boolean; +procedure FD_SET(Socket: TSocket; var FDSet: TFDSet); +procedure FD_ZERO(var FDSet: TFDSet); + +{=============================================================================} {$IFDEF LINUX} const WSAEINTR = EINTR; @@ -112,190 +803,345 @@ const WSAHOST_NOT_FOUND = HOST_NOT_FOUND; WSATRY_AGAIN = TRY_AGAIN; WSANO_RECOVERY = NO_RECOVERY; -// WSANO_DATA = NO_DATA; WSANO_DATA = -6; + EAI_BADFLAGS = -1; { Invalid value for `ai_flags' field. } + EAI_NONAME = -2; { NAME or SERVICE is unknown. } + EAI_AGAIN = -3; { Temporary failure in name resolution. } + EAI_FAIL = -4; { Non-recoverable failure in name res. } + EAI_NODATA = -5; { No address associated with NAME. } + EAI_FAMILY = -6; { `ai_family' not supported. } + EAI_SOCKTYPE = -7; { `ai_socktype' not supported. } + EAI_SERVICE = -8; { SERVICE not supported for `ai_socktype'. } + EAI_ADDRFAMILY = -9; { Address family for NAME not supported. } + EAI_MEMORY = -10; { Memory allocation failure. } + EAI_SYSTEM = -11; { System error returned in `errno'. } + {$ELSE} const - DLLStackName = 'wsock32.dll'; + +{ All Windows Sockets error constants are biased by WSABASEERR from the "normal" } + WSABASEERR = 10000; + +{ Windows Sockets definitions of regular Microsoft C error constants } + + WSAEINTR = (WSABASEERR+4); + WSAEBADF = (WSABASEERR+9); + WSAEACCES = (WSABASEERR+13); + WSAEFAULT = (WSABASEERR+14); + WSAEINVAL = (WSABASEERR+22); + WSAEMFILE = (WSABASEERR+24); + +{ Windows Sockets definitions of regular Berkeley error constants } + + WSAEWOULDBLOCK = (WSABASEERR+35); + WSAEINPROGRESS = (WSABASEERR+36); + WSAEALREADY = (WSABASEERR+37); + WSAENOTSOCK = (WSABASEERR+38); + WSAEDESTADDRREQ = (WSABASEERR+39); + WSAEMSGSIZE = (WSABASEERR+40); + WSAEPROTOTYPE = (WSABASEERR+41); + WSAENOPROTOOPT = (WSABASEERR+42); + WSAEPROTONOSUPPORT = (WSABASEERR+43); + WSAESOCKTNOSUPPORT = (WSABASEERR+44); + WSAEOPNOTSUPP = (WSABASEERR+45); + WSAEPFNOSUPPORT = (WSABASEERR+46); + WSAEAFNOSUPPORT = (WSABASEERR+47); + WSAEADDRINUSE = (WSABASEERR+48); + WSAEADDRNOTAVAIL = (WSABASEERR+49); + WSAENETDOWN = (WSABASEERR+50); + WSAENETUNREACH = (WSABASEERR+51); + WSAENETRESET = (WSABASEERR+52); + WSAECONNABORTED = (WSABASEERR+53); + WSAECONNRESET = (WSABASEERR+54); + WSAENOBUFS = (WSABASEERR+55); + WSAEISCONN = (WSABASEERR+56); + WSAENOTCONN = (WSABASEERR+57); + WSAESHUTDOWN = (WSABASEERR+58); + WSAETOOMANYREFS = (WSABASEERR+59); + WSAETIMEDOUT = (WSABASEERR+60); + WSAECONNREFUSED = (WSABASEERR+61); + WSAELOOP = (WSABASEERR+62); + WSAENAMETOOLONG = (WSABASEERR+63); + WSAEHOSTDOWN = (WSABASEERR+64); + WSAEHOSTUNREACH = (WSABASEERR+65); + WSAENOTEMPTY = (WSABASEERR+66); + WSAEPROCLIM = (WSABASEERR+67); + WSAEUSERS = (WSABASEERR+68); + WSAEDQUOT = (WSABASEERR+69); + WSAESTALE = (WSABASEERR+70); + WSAEREMOTE = (WSABASEERR+71); + +{ Extended Windows Sockets error constant definitions } + + WSASYSNOTREADY = (WSABASEERR+91); + WSAVERNOTSUPPORTED = (WSABASEERR+92); + WSANOTINITIALISED = (WSABASEERR+93); + WSAEDISCON = (WSABASEERR+101); + WSAENOMORE = (WSABASEERR+102); + WSAECANCELLED = (WSABASEERR+103); + WSAEEINVALIDPROCTABLE = (WSABASEERR+104); + WSAEINVALIDPROVIDER = (WSABASEERR+105); + WSAEPROVIDERFAILEDINIT = (WSABASEERR+106); + WSASYSCALLFAILURE = (WSABASEERR+107); + WSASERVICE_NOT_FOUND = (WSABASEERR+108); + WSATYPE_NOT_FOUND = (WSABASEERR+109); + WSA_E_NO_MORE = (WSABASEERR+110); + WSA_E_CANCELLED = (WSABASEERR+111); + WSAEREFUSED = (WSABASEERR+112); + +{ Error return codes from gethostbyname() and gethostbyaddr() + (when using the resolver). Note that these errors are + retrieved via WSAGetLastError() and must therefore follow + the rules for avoiding clashes with error numbers from + specific implementations or language run-time systems. + For this reason the codes are based at WSABASEERR+1001. + Note also that [WSA]NO_ADDRESS is defined only for + compatibility purposes. } + +{ Authoritative Answer: Host not found } + WSAHOST_NOT_FOUND = (WSABASEERR+1001); + HOST_NOT_FOUND = WSAHOST_NOT_FOUND; +{ Non-Authoritative: Host not found, or SERVERFAIL } + WSATRY_AGAIN = (WSABASEERR+1002); + TRY_AGAIN = WSATRY_AGAIN; +{ Non recoverable errors, FORMERR, REFUSED, NOTIMP } + WSANO_RECOVERY = (WSABASEERR+1003); + NO_RECOVERY = WSANO_RECOVERY; +{ Valid name, no data record of requested type } + WSANO_DATA = (WSABASEERR+1004); + NO_DATA = WSANO_DATA; +{ no address, look for MX record } + WSANO_ADDRESS = WSANO_DATA; + NO_ADDRESS = WSANO_ADDRESS; + + EWOULDBLOCK = WSAEWOULDBLOCK; + EINPROGRESS = WSAEINPROGRESS; + EALREADY = WSAEALREADY; + ENOTSOCK = WSAENOTSOCK; + EDESTADDRREQ = WSAEDESTADDRREQ; + EMSGSIZE = WSAEMSGSIZE; + EPROTOTYPE = WSAEPROTOTYPE; + ENOPROTOOPT = WSAENOPROTOOPT; + EPROTONOSUPPORT = WSAEPROTONOSUPPORT; + ESOCKTNOSUPPORT = WSAESOCKTNOSUPPORT; + EOPNOTSUPP = WSAEOPNOTSUPP; + EPFNOSUPPORT = WSAEPFNOSUPPORT; + EAFNOSUPPORT = WSAEAFNOSUPPORT; + EADDRINUSE = WSAEADDRINUSE; + EADDRNOTAVAIL = WSAEADDRNOTAVAIL; + ENETDOWN = WSAENETDOWN; + ENETUNREACH = WSAENETUNREACH; + ENETRESET = WSAENETRESET; + ECONNABORTED = WSAECONNABORTED; + ECONNRESET = WSAECONNRESET; + ENOBUFS = WSAENOBUFS; + EISCONN = WSAEISCONN; + ENOTCONN = WSAENOTCONN; + ESHUTDOWN = WSAESHUTDOWN; + ETOOMANYREFS = WSAETOOMANYREFS; + ETIMEDOUT = WSAETIMEDOUT; + ECONNREFUSED = WSAECONNREFUSED; + ELOOP = WSAELOOP; + ENAMETOOLONG = WSAENAMETOOLONG; + EHOSTDOWN = WSAEHOSTDOWN; + EHOSTUNREACH = WSAEHOSTUNREACH; + ENOTEMPTY = WSAENOTEMPTY; + EPROCLIM = WSAEPROCLIM; + EUSERS = WSAEUSERS; + EDQUOT = WSAEDQUOT; + ESTALE = WSAESTALE; + EREMOTE = WSAEREMOTE; + + EAI_ADDRFAMILY = 1; // Address family for nodename not supported. + EAI_AGAIN = 2; // Temporary failure in name resolution. + EAI_BADFLAGS = 3; // Invalid value for ai_flags. + EAI_FAIL = 4; // Non-recoverable failure in name resolution. + EAI_FAMILY = 5; // Address family ai_family not supported. + EAI_MEMORY = 6; // Memory allocation failure. + EAI_NODATA = 7; // No address associated with nodename. + EAI_NONAME = 8; // Nodename nor servname provided, or not known. + EAI_SERVICE = 9; // Servname not supported for ai_socktype. + EAI_SOCKTYPE = 10; // Socket type ai_socktype not supported. + EAI_SYSTEM = 11; // System error returned in errno. + +{$ENDIF} + +{=============================================================================} var - LibHandle: THandle = 0; + WSAStartup: function(wVersionRequired: Word; var WSData: TWSAData): Integer + {$IFDEF LINUX}cdecl{$ELSE}stdcall{$ENDIF} = nil; + WSACleanup: function: Integer + {$IFDEF LINUX}cdecl{$ELSE}stdcall{$ENDIF} = nil; + WSAGetLastError: function: Integer + {$IFDEF LINUX}cdecl{$ELSE}stdcall{$ENDIF} = nil; + GetServByName: function(name, proto: PChar): PServEnt + {$IFDEF LINUX}cdecl{$ELSE}stdcall{$ENDIF} = nil; + GetServByPort: function(port: Integer; proto: PChar): PServEnt + {$IFDEF LINUX}cdecl{$ELSE}stdcall{$ENDIF} = nil; + GetProtoByName: function(name: PChar): PProtoEnt + {$IFDEF LINUX}cdecl{$ELSE}stdcall{$ENDIF} = nil; + GetProtoByNumber: function(proto: Integer): PProtoEnt + {$IFDEF LINUX}cdecl{$ELSE}stdcall{$ENDIF} = nil; + GetHostByName: function(name: PChar): PHostEnt + {$IFDEF LINUX}cdecl{$ELSE}stdcall{$ENDIF} = nil; + GetHostByAddr: function(addr: Pointer; len, Struc: Integer): PHostEnt + {$IFDEF LINUX}cdecl{$ELSE}stdcall{$ENDIF} = nil; + GetHostName: function(name: PChar; len: Integer): Integer + {$IFDEF LINUX}cdecl{$ELSE}stdcall{$ENDIF} = nil; + Shutdown: function(s: TSocket; how: Integer): Integer + {$IFDEF LINUX}cdecl{$ELSE}stdcall{$ENDIF} = nil; + SetSockOpt: function(s: TSocket; level, optname: Integer; optval: PChar; + optlen: Integer): Integer {$IFDEF LINUX}cdecl{$ELSE}stdcall{$ENDIF} = nil; + GetSockOpt: function(s: TSocket; level, optname: Integer; optval: PChar; + var optlen: Integer): Integer {$IFDEF LINUX}cdecl{$ELSE}stdcall{$ENDIF} = nil; + SendTo: function(s: TSocket; var Buf; len, flags: Integer; addrto: PSockAddr; + tolen: Integer): Integer {$IFDEF LINUX}cdecl{$ELSE}stdcall{$ENDIF} = nil; + Send: function(s: TSocket; var Buf; len, flags: Integer): Integer + {$IFDEF LINUX}cdecl{$ELSE}stdcall{$ENDIF} = nil; + Recv: function(s: TSocket; var Buf; len, flags: Integer): Integer + {$IFDEF LINUX}cdecl{$ELSE}stdcall{$ENDIF} = nil; + RecvFrom: function(s: TSocket; var Buf; len, flags: Integer; from: PSockAddr; + var fromlen: Integer): Integer {$IFDEF LINUX}cdecl{$ELSE}stdcall{$ENDIF} = nil; + ntohs: function(netshort: u_short): u_short + {$IFDEF LINUX}cdecl{$ELSE}stdcall{$ENDIF} = nil; + ntohl: function(netlong: u_long): u_long + {$IFDEF LINUX}cdecl{$ELSE}stdcall{$ENDIF} = nil; + Listen: function(s: TSocket; backlog: Integer): Integer + {$IFDEF LINUX}cdecl{$ELSE}stdcall{$ENDIF} = nil; + IoctlSocket: function(s: TSocket; cmd: DWORD; var arg: u_long): Integer + {$IFDEF LINUX}cdecl{$ELSE}stdcall{$ENDIF} = nil; + Inet_ntoa: function(inaddr: TInAddr): PChar + {$IFDEF LINUX}cdecl{$ELSE}stdcall{$ENDIF} = nil; + Inet_addr: function(cp: PChar): u_long + {$IFDEF LINUX}cdecl{$ELSE}stdcall{$ENDIF} = nil; + htons: function(hostshort: u_short): u_short + {$IFDEF LINUX}cdecl{$ELSE}stdcall{$ENDIF} = nil; + htonl: function(hostlong: u_long): u_long + {$IFDEF LINUX}cdecl{$ELSE}stdcall{$ENDIF} = nil; + GetSockName: function(s: TSocket; name: PSockAddr; var namelen: Integer): Integer + {$IFDEF LINUX}cdecl{$ELSE}stdcall{$ENDIF} = nil; + GetPeerName: function(s: TSocket; name: PSockAddr; var namelen: Integer): Integer + {$IFDEF LINUX}cdecl{$ELSE}stdcall{$ENDIF} = nil; + Connect: function(s: TSocket; name: PSockAddr; namelen: Integer): Integer + {$IFDEF LINUX}cdecl{$ELSE}stdcall{$ENDIF} = nil; + CloseSocket: function(s: TSocket): Integer + {$IFDEF LINUX}cdecl{$ELSE}stdcall{$ENDIF} = nil; + Bind: function(s: TSocket; addr: PSockAddr; namelen: Integer): Integer + {$IFDEF LINUX}cdecl{$ELSE}stdcall{$ENDIF} = nil; + Accept: function(s: TSocket; addr: PSockAddr; var addrlen: Integer): TSocket + {$IFDEF LINUX}cdecl{$ELSE}stdcall{$ENDIF} = nil; + Socket: function(af, Struc, Protocol: Integer): TSocket + {$IFDEF LINUX}cdecl{$ELSE}stdcall{$ENDIF} = nil; + Select: function(nfds: Integer; readfds, writefds, exceptfds: PFDSet; + timeout: PTimeVal): Longint {$IFDEF LINUX}cdecl{$ELSE}stdcall{$ENDIF} = nil; + + GetAddrInfo: function(NodeName: PChar; ServName: PChar; Hints: PAddrInfo; + var Addrinfo: PAddrInfo): integer + {$IFDEF LINUX}cdecl{$ELSE}stdcall{$ENDIF} = nil; + FreeAddrInfo: procedure(ai: PAddrInfo) + {$IFDEF LINUX}cdecl{$ELSE}stdcall{$ENDIF} = nil; + GetNameInfo: function( addr: PSockAddr; namelen: Integer; host: PChar; + hostlen: DWORD; serv: PChar; servlen: DWORD; flags: integer): integer + {$IFDEF LINUX}cdecl{$ELSE}stdcall{$ENDIF} = nil; + +{$IFNDEF LINUX} + __WSAFDIsSet: function (s: TSocket; var FDSet: TFDSet): Bool stdcall = nil; + WSAIoctl: function (s: TSocket; dwIoControlCode: DWORD; lpvInBuffer: Pointer; + cbInBuffer: DWORD; lpvOutBuffer: Pointer; cbOutBuffer: DWORD; + lpcbBytesReturned: PDWORD; lpOverlapped: Pointer; + lpCompletionRoutine: pointer): u_int stdcall = nil; {$ENDIF} {$IFDEF LINUX} -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; - DWORD = Integer; - TLinger = Linger; -{$ENDIF} - -type - TWSAStartup = function(wVersionRequired: Word; - var WSData: TWSAData): Integer; stdcall; - TWSACleanup = function: Integer; stdcall; - TWSAGetLastError = function: Integer; stdcall; - TGetServByName = function(name, proto: PChar): PServEnt; stdcall; - TGetServByPort = function(port: Integer; proto: PChar): PServEnt; stdcall; - TGetProtoByName = function(name: PChar): PProtoEnt; stdcall; - TGetProtoByNumber = function(proto: Integer): PProtoEnt; stdcall; - TGetHostByName = function(name: PChar): PHostEnt; stdcall; - TGetHostByAddr = function(addr: Pointer; len, Struc: Integer): PHostEnt; stdcall; - TGetHostName = function(name: PChar; len: Integer): Integer; stdcall; - TShutdown = function(s: TSocket; how: Integer): Integer; stdcall; - TSetSockOpt = function(s: TSocket; level, optname: Integer; - optval: PChar; optlen: Integer): Integer; stdcall; - TGetSockOpt = function(s: TSocket; level, optname: Integer; - optval: PChar; var optlen: Integer): Integer; stdcall; - TSendTo = function(s: TSocket; var Buf; - len, flags: Integer; var addrto: TSockAddr; - tolen: Integer): Integer; stdcall; - TSend = function(s: TSocket; var Buf; - len, flags: Integer): Integer; stdcall; - TRecv = function(s: TSocket; - var Buf; len, flags: Integer): Integer; stdcall; - TRecvFrom = function(s: TSocket; - var Buf; len, flags: Integer; var from: TSockAddr; - var fromlen: Integer): Integer; stdcall; - Tntohs = function(netshort: u_short): u_short; stdcall; - Tntohl = function(netlong: u_long): u_long; stdcall; - TListen = function(s: TSocket; backlog: Integer): Integer; stdcall; - TIoctlSocket = function(s: TSocket; cmd: DWORD; - var arg: u_long): Integer; stdcall; - TInet_ntoa = function(inaddr: TInAddr): PChar; stdcall; - TInet_addr = function(cp: PChar): u_long; stdcall; - Thtons = function(hostshort: u_short): u_short; stdcall; - Thtonl = function(hostlong: u_long): u_long; stdcall; - TGetSockName = function(s: TSocket; var name: TSockAddr; - var namelen: Integer): Integer; stdcall; - TGetPeerName = function(s: TSocket; var name: TSockAddr; - var namelen: Integer): Integer; stdcall; - TConnect = function(s: TSocket; var name: TSockAddr; - namelen: Integer): Integer; stdcall; - TCloseSocket = function(s: TSocket): Integer; stdcall; - TBind = function(s: TSocket; var addr: TSockAddr; - namelen: Integer): Integer; stdcall; - TAccept = function(s: TSocket; addr: PSockAddr; - addrlen: PInteger): TSocket; stdcall; - TSocketProc = function(af, Struc, Protocol: Integer): TSocket; stdcall; - TSelect = function(nfds: Integer; readfds, writefds, exceptfds: PFDSet; - timeout: PTimeVal): Longint; stdcall; - -var - WSAStartup: TWSAStartup = nil; - WSACleanup: TWSACleanup = nil; - WSAGetLastError: TWSAGetLastError = nil; - GetServByName: TGetServByName = nil; - GetServByPort: TGetServByPort = nil; - GetProtoByName: TGetProtoByName = nil; - GetProtoByNumber: TGetProtoByNumber = nil; - GetHostByName: TGetHostByName = nil; - GetHostByAddr: TGetHostByAddr = nil; - GetHostName: TGetHostName = nil; - Shutdown: TShutdown = nil; - SetSockOpt: TSetSockOpt = nil; - GetSockOpt: TGetSockOpt = nil; - SendTo: TSendTo = nil; - Send: TSend = nil; - Recv: TRecv = nil; - RecvFrom: TRecvFrom = nil; - ntohs: Tntohs = nil; - ntohl: Tntohl = nil; - Listen: TListen = nil; - IoctlSocket: TIoctlSocket = nil; - Inet_ntoa: TInet_ntoa = nil; - Inet_addr: TInet_addr = nil; - htons: Thtons = nil; - htonl: Thtonl = nil; - GetSockName: TGetSockName = nil; - GetPeerName: TGetPeerName = nil; - Connect: TConnect = nil; - CloseSocket: TCloseSocket = nil; - Bind: TBind = nil; - Accept: TAccept = nil; - Socket: TSocketProc = nil; - Select: TSelect = nil; - -function InitSocketInterface(stack: string): Boolean; -function DestroySocketInterface: Boolean; - -{$IFDEF LINUX} -function LSWSAStartup(wVersionRequired: Word; var WSData: TWSAData): Integer; stdcall; -function LSWSACleanup: Integer; stdcall; -function LSWSAGetLastError: Integer; stdcall; -function LSGetServByName(name, proto: PChar): PServEnt; stdcall; -function LSGetServByPort(port: Integer; proto: PChar): PServEnt; stdcall; -function LSGetProtoByName(name: PChar): PProtoEnt; stdcall; -function LSGetProtoByNumber(proto: Integer): PProtoEnt; stdcall; -function LSGetHostByName(name: PChar): PHostEnt; stdcall; -function LSGetHostByAddr(addr: Pointer; len, Struc: Integer): PHostEnt; stdcall; -function LSGetHostName(name: PChar; len: Integer): Integer; stdcall; -function LSShutdown(s: TSocket; how: Integer): Integer; stdcall; -function LSSetSockOpt(s: TSocket; level, optname: Integer; optval: PChar; - optlen: Integer): Integer; stdcall; -function LSGetSockOpt(s: TSocket; level, optname: Integer; optval: PChar; - var optlen: Integer): Integer; stdcall; -function LSSendTo(s: TSocket; var Buf; len, flags: Integer; - var addrto: TSockAddr; tolen: Integer): Integer; stdcall; -function LSSend(s: TSocket; var Buf; len, flags: Integer): Integer; stdcall; -function LSRecv(s: TSocket; var Buf; len, flags: Integer): Integer; stdcall; -function LSRecvFrom(s: TSocket; var Buf; len, flags: Integer; - var from: TSockAddr; var fromlen: Integer): Integer; stdcall; -function LSntohs(netshort: u_short): u_short; stdcall; -function LSntohl(netlong: u_long): u_long; stdcall; -function LSListen(s: TSocket; backlog: Integer): Integer; stdcall; -function LSIoctlSocket(s: TSocket; cmd: DWORD; var arg: u_long): Integer; stdcall; -function LSInet_ntoa(inaddr: TInAddr): PChar; stdcall; -function LSInet_addr(cp: PChar): u_long; stdcall; -function LShtons(hostshort: u_short): u_short; stdcall; -function LShtonl(hostlong: u_long): u_long; stdcall; -function LSGetSockName(s: TSocket; var name: TSockAddr; - var namelen: Integer): Integer; stdcall; -function LSGetPeerName(s: TSocket; var name: TSockAddr; - var namelen: Integer): Integer; stdcall; -function LSConnect(s: TSocket; var name: TSockAddr; namelen: Integer): Integer; stdcall; -function LSCloseSocket(s: TSocket): Integer; stdcall; -function LSBind(s: TSocket; var addr: TSockAddr; namelen: Integer): Integer; stdcall; -function LSAccept(s: TSocket; addr: PSockAddr; addrlen: PInteger): TSocket; stdcall; -function LSSocketProc(af, Struc, Protocol: Integer): TSocket; stdcall; -function LSSelect(nfds: Integer; readfds, writefds, exceptfds: PFDSet; - timeout: PTimeVal): Longint; stdcall; +function LSWSAStartup(wVersionRequired: Word; var WSData: TWSAData): Integer; cdecl; +function LSWSACleanup: Integer; cdecl; +function LSWSAGetLastError: Integer; cdecl; {$ENDIF} var SynSockCS: TCriticalSection; + SockEnhancedApi: Boolean; + SockWship6Api: Boolean; + +const +{$IFDEF LINUX} + DLLStackName = 'libc.so.6'; +{$ELSE} + {$IFDEF WINSOCK1} + DLLStackName = 'wsock32.dll'; + {$ELSE} + DLLStackName = 'ws2_32.dll'; + {$ENDIF} + DLLwship6 = 'wship6.dll'; +{$ENDIF} implementation -{$IFNDEF LINUX} -{$IFNDEF STATICWINSOCK} var SynSockCount: Integer = 0; -{$ENDIF} -{$ENDIF} + LibHandle: THandle = 0; + Libwship6Handle: THandle = 0; +function IN6_IS_ADDR_UNSPECIFIED(const a: PInAddr6): boolean; +begin + Result := ((a^.s_un_dw.s_dw1 = 0) and (a^.s_un_dw.s_dw2 = 0) and + (a^.s_un_dw.s_dw3 = 0) and (a^.s_un_dw.s_dw4 = 0)); +end; + +function IN6_IS_ADDR_LOOPBACK(const a: PInAddr6): boolean; +begin + Result := ((a^.s_un_dw.s_dw1 = 0) and (a^.s_un_dw.s_dw2 = 0) and + (a^.s_un_dw.s_dw3 = 0) and + (a^.s_un_b.s_b13 = char(0)) and (a^.s_un_b.s_b14 = char(0)) and + (a^.s_un_b.s_b15 = char(0)) and (a^.s_un_b.s_b16 = char(1))); +end; + +function IN6_IS_ADDR_LINKLOCAL(const a: PInAddr6): boolean; +begin + Result := ((a^.s_un_b.s_b1 = u_char($FE)) and (a^.s_un_b.s_b2 = u_char($80))); +end; + +function IN6_IS_ADDR_SITELOCAL(const a: PInAddr6): boolean; +begin + Result := ((a^.s_un_b.s_b1 = u_char($FE)) and (a^.s_un_b.s_b2 = u_char($C0))); +end; + +function IN6_IS_ADDR_MULTICAST(const a: PInAddr6): boolean; +begin + Result := (a^.s_un_b.s_b1 = char($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^.s_un_b.s_b16 := char(1); +end; + +{=============================================================================} {$IFDEF LINUX} +var + errno_loc: function: PInteger cdecl = nil; function LSWSAStartup(wVersionRequired: Word; var WSData: TWSAData): Integer; begin with WSData do begin wVersion := wVersionRequired; - wHighVersion := $101; - szDescription := 'Synapse Platform Independent Socket Layer'; - szSystemStatus := 'On Linux'; + wHighVersion := $202; + szDescription := 'Synsock - Synapse Platform Independent Socket Layer'; + szSystemStatus := 'Running on Linux'; iMaxSockets := 32768; iMaxUdpDg := 8192; end; @@ -309,283 +1155,174 @@ end; function LSWSAGetLastError: Integer; begin - Result := System.GetLastError; + Result := errno_loc^; end; -function LSGetServByName(name, proto: PChar): PServEnt; +function __FDELT(Socket: TSocket): Integer; begin - Result := libc.GetServByName(name, proto); + Result := Socket div __NFDBITS; end; -function LSGetServByPort(port: Integer; proto: PChar): PServEnt; +function __FDMASK(Socket: TSocket): __fd_mask; begin - Result := libc.GetServByPort(port, proto); + Result := 1 shl (Socket mod __NFDBITS); end; -function LSGetProtoByName(name: PChar): PProtoEnt; +function FD_ISSET(Socket: TSocket; var fdset: TFDSet): Boolean; begin - Result := libc.GetProtoByName(Name); + Result := (fdset.fds_bits[__FDELT(Socket)] and __FDMASK(Socket)) <> 0; end; -function LSGetProtoByNumber(proto: Integer): PProtoEnt; +procedure FD_SET(Socket: TSocket; var fdset: TFDSet); begin - Result := libc.GetProtoByNumber(proto); + fdset.fds_bits[__FDELT(Socket)] := fdset.fds_bits[__FDELT(Socket)] or __FDMASK(Socket); end; -function LSGetHostByName(name: PChar): PHostEnt; +procedure FD_CLR(Socket: TSocket; var fdset: TFDSet); begin - Result := libc.GetHostByName(Name); + fdset.fds_bits[__FDELT(Socket)] := fdset.fds_bits[__FDELT(Socket)] and (not __FDMASK(Socket)); end; -function LSGetHostByAddr(addr: Pointer; len, Struc: Integer): PHostEnt; +procedure FD_ZERO(var fdset: TFDSet); +var + I: Integer; begin - Result := libc.GetHostByAddr(Addr, len, struc); + with fdset do + for I := Low(fds_bits) to High(fds_bits) do + fds_bits[I] := 0; end; -function LSGetHostName(name: PChar; len: Integer): Integer; +{=============================================================================} +{$ELSE} +procedure FD_CLR(Socket: TSocket; var FDSet: TFDSet); +var + I: Integer; begin - Result := libc.GetHostName(Name, Len); + I := 0; + while I < FDSet.fd_count do + begin + if FDSet.fd_array[I] = Socket then + begin + while I < FDSet.fd_count - 1 do + begin + FDSet.fd_array[I] := FDSet.fd_array[I + 1]; + Inc(I); + end; + Dec(FDSet.fd_count); + Break; + end; + Inc(I); + end; end; -function LSShutdown(s: TSocket; how: Integer): Integer; +function FD_ISSET(Socket: TSocket; var FDSet: TFDSet): Boolean; begin - Result := libc.Shutdown(S, How); + Result := __WSAFDIsSet(Socket, FDSet); end; -function LSSetSockOpt(s: TSocket; level, optname: Integer; optval: PChar; - optlen: Integer): Integer; +procedure FD_SET(Socket: TSocket; var FDSet: TFDSet); begin - Result := libc.SetSockOpt(S, Level, OptName, OptVal, OptLen); + if FDSet.fd_count < FD_SETSIZE then + begin + FDSet.fd_array[FDSet.fd_count] := Socket; + Inc(FDSet.fd_count); + end; end; -function LSGetSockOpt(s: TSocket; level, optname: Integer; optval: PChar; - var optlen: Integer): Integer; +procedure FD_ZERO(var FDSet: TFDSet); begin - Result := libc.getsockopt(s, level, optname, optval, cardinal(optlen)); + FDSet.fd_count := 0; end; - -function LSSendTo(s: TSocket; var Buf; len, flags: Integer; - var addrto: TSockAddr; tolen: Integer): Integer; -begin - Result := libc.SendTo(S, Buf, Len, Flags, Addrto, Tolen); -end; - -function LSSend(s: TSocket; var Buf; len, flags: Integer): Integer; -begin - Result := libc.Send(S, Buf, Len, Flags); -end; - -function LSRecv(s: TSocket; var Buf; len, flags: Integer): Integer; -begin - Result := libc.Recv(S, Buf, Len, Flags); -end; - -function LSRecvFrom(s: TSocket; var Buf; len, flags: Integer; - var from: TSockAddr; var fromlen: Integer): Integer; -begin - Result := libc.RecvFrom(S, Buf, Len, Flags, @from, @fromlen); -end; - -function LSntohs(netshort: u_short): u_short; -begin - Result := libc.NToHS(netshort); -end; - -function LSntohl(netlong: u_long): u_long; -begin - Result := libc.NToHL(netlong); -end; - -function LSListen(s: TSocket; backlog: Integer): Integer; -begin - Result := libc.Listen(S, Backlog); -end; - -function LSIoctlSocket(s: TSocket; cmd: DWORD; var arg: u_long): Integer; -begin - Result := libc.ioctl(s, cmd, @arg); -end; - -function LSInet_ntoa(inaddr: TInAddr): PChar; -begin - Result := libc.inet_ntoa(inaddr); -end; - -function LSInet_addr(cp: PChar): u_long; -begin - Result := libc.inet_addr(cp); -end; - -function LShtons(hostshort: u_short): u_short; -begin - Result := libc.HToNs(HostShort); -end; - -function LShtonl(hostlong: u_long): u_long; -begin - Result := libc.HToNL(HostLong); -end; - -function LSGetSockName(s: TSocket; var name: TSockAddr; var namelen: Integer): Integer; -begin - Result := libc.GetSockName(S, Name, cardinal(namelen)); -end; - -function LSGetPeerName(s: TSocket; var name: TSockAddr; var namelen: Integer): Integer; -begin - Result := libc.GetPeerName(S, Name, cardinal(namelen)); -end; - -function LSConnect(s: TSocket; var name: TSockAddr; namelen: Integer): Integer; -begin - Result := libc.Connect(S, name, namelen); -end; - -function LSCloseSocket(s: TSocket): Integer; -begin - Result := libc.__close(s); -end; - -function LSBind(s: TSocket; var addr: TSockAddr; namelen: Integer): Integer; -begin - Result := libc.Bind(S, addr, namelen); -end; - -function LSAccept(s: TSocket; addr: PSockAddr; addrlen: PInteger): TSocket; -begin - Result := libc.Accept(S, addr, psocketlength(addrlen)); -end; - -function LSSocketProc(af, Struc, Protocol: Integer): TSocket; -begin - Result := libc.Socket(Af, Struc, Protocol); -end; - -function LSSelect(nfds: Integer; readfds, writefds, exceptfds: PFDSet; - timeout: PTimeVal): Longint; -begin - Result := libc.Select(nfds, readfds, writefds, exceptfds, timeout); -end; - {$ENDIF} +{=============================================================================} + function InitSocketInterface(stack: string): Boolean; begin -{$IFDEF LINUX} - Accept := LSAccept; - Bind := LSBind; - CloseSocket := LSCloseSocket; - Connect := LSConnect; - GetPeerName := LSGetPeerName; - GetSockName := LSGetSockName; - GetSockOpt := LSGetSockOpt; - Htonl := LShtonl; - Htons := LShtons; - Inet_Addr := LSinet_addr; - Inet_Ntoa := LSinet_ntoa; - IoctlSocket := LSioctlsocket; - Listen := LSlisten; - Ntohl := LSntohl; - Ntohs := LSntohs; - Recv := LSrecv; - RecvFrom := LSrecvfrom; - Select := LSselect; - Send := LSsend; - SendTo := LSsendto; - SetSockOpt := LSsetsockopt; - ShutDown := LSshutdown; - Socket := LSsocketProc; - GetHostByAddr := LSGetHostByAddr; - GetHostByName := LSGetHostByName; - GetProtoByName := LSGetProtoByName; - GetProtoByNumber := LSGetProtoByNumber; - GetServByName := LSGetServByName; - GetServByPort := LSGetServByPort; - GetHostName := LSGetHostName; - WSAGetLastError := LSWSAGetLastError; - WSAStartup := LSWSAStartup; - WSACleanup := LSWSACleanup; - Result := True; -{$ELSE} -{$IFDEF STATICWINSOCK} - Accept := Winsock.Accept; - Bind := Winsock.Bind; - CloseSocket := Winsock.CloseSocket; - Connect := Winsock.Connect; - GetPeerName := Winsock.GetPeerName; - GetSockName := Winsock.GetSockName; - GetSockOpt := Winsock.GetSockOpt; - Htonl := Winsock.htonl; - Htons := Winsock.htons; - Inet_Addr := Winsock.inet_addr; - Inet_Ntoa := Winsock.inet_ntoa; - IoctlSocket := Winsock.ioctlsocket; - Listen := Winsock.listen; - Ntohl := Winsock.ntohl; - Ntohs := Winsock.ntohs; - Recv := Winsock.recv; - RecvFrom := Winsock.recvfrom; - Select := Winsock.select; - Send := Winsock.send; - SendTo := Winsock.sendto; - SetSockOpt := Winsock.setsockopt; - ShutDown := Winsock.shutdown; - Socket := Winsock.socket; - GetHostByAddr := Winsock.GetHostByAddr; - GetHostByName := Winsock.GetHostByName; - GetProtoByName := Winsock.GetProtoByName; - GetProtoByNumber := Winsock.GetProtoByNumber; - GetServByName := Winsock.GetServByName; - GetServByPort := Winsock.GetServByPort; - GetHostName := Winsock.GetHostName; - WSAGetLastError := Winsock.WSAGetLastError; - WSAStartup := Winsock.WSAStartup; - WSACleanup := Winsock.WSACleanup; - Result := True; -{$ELSE} Result := False; + SockEnhancedApi := False; if stack = '' then stack := DLLStackName; SynSockCS.Enter; try if SynSockCount = 0 then begin - LibHandle := Windows.LoadLibrary(PChar(Stack)); + SockEnhancedApi := False; + SockWship6Api := False; +{$IFDEF LINUX} + Libc.Signal(Libc.SIGPIPE, TSignalHandler(Libc.SIG_IGN)); + LibHandle := HMODULE(dlopen(PChar(Stack), RTLD_GLOBAL)); +{$ELSE} + LibHandle := LoadLibrary(PChar(Stack)); +{$ENDIF} if LibHandle <> 0 then begin - Accept := Windows.GetProcAddress(LibHandle, PChar('accept')); - Bind := Windows.GetProcAddress(LibHandle, PChar('bind')); - CloseSocket := Windows.GetProcAddress(LibHandle, PChar('closesocket')); - Connect := Windows.GetProcAddress(LibHandle, PChar('connect')); - GetPeerName := Windows.GetProcAddress(LibHandle, PChar('getpeername')); - GetSockName := Windows.GetProcAddress(LibHandle, PChar('getsockname')); - GetSockOpt := Windows.GetProcAddress(LibHandle, PChar('getsockopt')); - Htonl := Windows.GetProcAddress(LibHandle, PChar('htonl')); - Htons := Windows.GetProcAddress(LibHandle, PChar('htons')); - Inet_Addr := Windows.GetProcAddress(LibHandle, PChar('inet_addr')); - Inet_Ntoa := Windows.GetProcAddress(LibHandle, PChar('inet_ntoa')); - IoctlSocket := Windows.GetProcAddress(LibHandle, PChar('ioctlsocket')); - Listen := Windows.GetProcAddress(LibHandle, PChar('listen')); - Ntohl := Windows.GetProcAddress(LibHandle, PChar('ntohl')); - Ntohs := Windows.GetProcAddress(LibHandle, PChar('ntohs')); - Recv := Windows.GetProcAddress(LibHandle, PChar('recv')); - RecvFrom := Windows.GetProcAddress(LibHandle, PChar('recvfrom')); - Select := Windows.GetProcAddress(LibHandle, PChar('select')); - Send := Windows.GetProcAddress(LibHandle, PChar('send')); - SendTo := Windows.GetProcAddress(LibHandle, PChar('sendto')); - SetSockOpt := Windows.GetProcAddress(LibHandle, PChar('setsockopt')); - ShutDown := Windows.GetProcAddress(LibHandle, PChar('shutdown')); - Socket := Windows.GetProcAddress(LibHandle, PChar('socket')); - GetHostByAddr := Windows.GetProcAddress(LibHandle, PChar('gethostbyaddr')); - GetHostByName := Windows.GetProcAddress(LibHandle, PChar('gethostbyname')); - GetProtoByName := Windows.GetProcAddress(LibHandle, PChar('getprotobyname')); - GetProtoByNumber := Windows.GetProcAddress(LibHandle, PChar('getprotobynumber')); - GetServByName := Windows.GetProcAddress(LibHandle, PChar('getservbyname')); - GetServByPort := Windows.GetProcAddress(LibHandle, PChar('getservbyport')); - GetHostName := Windows.GetProcAddress(LibHandle, PChar('gethostname')); - WSAGetLastError := Windows.GetProcAddress(LibHandle, PChar('WSAGetLastError')); - WSAStartup := Windows.GetProcAddress(LibHandle, PChar('WSAStartup')); - WSACleanup := Windows.GetProcAddress(LibHandle, PChar('WSACleanup')); +{$IFDEF LINUX} + errno_loc := GetProcAddress(LibHandle, PChar('__errno_location')); + CloseSocket := GetProcAddress(LibHandle, PChar('close')); + IoctlSocket := GetProcAddress(LibHandle, PChar('ioctl')); + WSAGetLastError := LSWSAGetLastError; + WSAStartup := LSWSAStartup; + WSACleanup := LSWSACleanup; +{$ELSE} + WSAIoctl := GetProcAddress(LibHandle, PChar('WSAIoctl')); + __WSAFDIsSet := GetProcAddress(LibHandle, PChar('__WSAFDIsSet')); + CloseSocket := GetProcAddress(LibHandle, PChar('closesocket')); + IoctlSocket := GetProcAddress(LibHandle, PChar('ioctlsocket')); + WSAGetLastError := GetProcAddress(LibHandle, PChar('WSAGetLastError')); + WSAStartup := GetProcAddress(LibHandle, PChar('WSAStartup')); + WSACleanup := GetProcAddress(LibHandle, PChar('WSACleanup')); +{$ENDIF} + Accept := GetProcAddress(LibHandle, PChar('accept')); + Bind := GetProcAddress(LibHandle, PChar('bind')); + Connect := GetProcAddress(LibHandle, PChar('connect')); + GetPeerName := GetProcAddress(LibHandle, PChar('getpeername')); + GetSockName := GetProcAddress(LibHandle, PChar('getsockname')); + GetSockOpt := GetProcAddress(LibHandle, PChar('getsockopt')); + Htonl := GetProcAddress(LibHandle, PChar('htonl')); + Htons := GetProcAddress(LibHandle, PChar('htons')); + Inet_Addr := GetProcAddress(LibHandle, PChar('inet_addr')); + Inet_Ntoa := GetProcAddress(LibHandle, PChar('inet_ntoa')); + Listen := GetProcAddress(LibHandle, PChar('listen')); + Ntohl := GetProcAddress(LibHandle, PChar('ntohl')); + Ntohs := GetProcAddress(LibHandle, PChar('ntohs')); + Recv := GetProcAddress(LibHandle, PChar('recv')); + RecvFrom := GetProcAddress(LibHandle, PChar('recvfrom')); + Select := GetProcAddress(LibHandle, PChar('select')); + Send := GetProcAddress(LibHandle, PChar('send')); + SendTo := GetProcAddress(LibHandle, PChar('sendto')); + SetSockOpt := GetProcAddress(LibHandle, PChar('setsockopt')); + ShutDown := GetProcAddress(LibHandle, PChar('shutdown')); + Socket := GetProcAddress(LibHandle, PChar('socket')); + GetHostByAddr := GetProcAddress(LibHandle, PChar('gethostbyaddr')); + GetHostByName := GetProcAddress(LibHandle, PChar('gethostbyname')); + GetProtoByName := GetProcAddress(LibHandle, PChar('getprotobyname')); + GetProtoByNumber := GetProcAddress(LibHandle, PChar('getprotobynumber')); + GetServByName := GetProcAddress(LibHandle, PChar('getservbyname')); + GetServByPort := GetProcAddress(LibHandle, PChar('getservbyport')); + GetHostName := GetProcAddress(LibHandle, PChar('gethostname')); + +{$IFNDEF FORCEOLDAPI} + GetAddrInfo := GetProcAddress(LibHandle, PChar('getaddrinfo')); + FreeAddrInfo := GetProcAddress(LibHandle, PChar('freeaddrinfo')); + GetNameInfo := GetProcAddress(LibHandle, PChar('getnameinfo')); + SockEnhancedApi := Assigned(GetAddrInfo) and Assigned(FreeAddrInfo) + and Assigned(GetNameInfo); + {$IFNDEF LINUX} + if not SockEnhancedApi then + begin + LibWship6Handle := LoadLibrary(PChar(DLLWship6)); + if LibWship6Handle <> 0 then + begin + GetAddrInfo := GetProcAddress(LibWship6Handle, PChar('getaddrinfo')); + FreeAddrInfo := GetProcAddress(LibWship6Handle, PChar('freeaddrinfo')); + GetNameInfo := GetProcAddress(LibWship6Handle, PChar('getnameinfo')); + SockWship6Api := Assigned(GetAddrInfo) and Assigned(FreeAddrInfo) + and Assigned(GetNameInfo); + end; + end; + {$ENDIF} +{$ENDIF} Result := True; end; end @@ -595,37 +1332,39 @@ begin finally SynSockCS.Leave; end; -{$ENDIF} -{$ENDIF} end; function DestroySocketInterface: Boolean; begin -{$IFDEF LINUX} -{$ELSE} -{$IFNDEF STATICWINSOCK} SynSockCS.Enter; try Dec(SynSockCount); if SynSockCount < 0 then SynSockCount := 0; if SynSockCount = 0 then + begin if LibHandle <> 0 then begin - Windows.FreeLibrary(libHandle); + FreeLibrary(libHandle); LibHandle := 0; end; + if LibWship6Handle <> 0 then + begin + FreeLibrary(LibWship6Handle); + LibWship6Handle := 0; + end; + end; finally SynSockCS.Leave; end; -{$ENDIF} -{$ENDIF} Result := True; end; initialization begin SynSockCS:= TCriticalSection.Create; + SET_IN6_IF_ADDR_ANY (@in6addr_any); + SET_LOOPBACK_ADDR6 (@in6addr_loopback); end; finalization diff --git a/tlntsend.pas b/tlntsend.pas index 97ad8d3..74fc8de 100644 --- a/tlntsend.pas +++ b/tlntsend.pas @@ -1,5 +1,5 @@ {==============================================================================| -| Project : Delphree - Synapse | 001.000.002 | +| Project : Delphree - Synapse | 001.001.001 | |==============================================================================| | Content: TELNET client | |==============================================================================| @@ -42,8 +42,6 @@ | (Found at URL: http://www.ararat.cz/synapse/) | |==============================================================================} -{$WEAKPACKAGEUNIT ON} - //RFC-854 unit TlntSend; @@ -87,6 +85,7 @@ type FSessionLog: string; FSubNeg: string; FSubType: char; + FTermType: string; function Connect: Boolean; function Negotiate(const Buf: string): string; procedure FilterHook(Sender: TObject; var Value: string); @@ -102,6 +101,7 @@ type published property Sock: TTCPBlockSocket read FSock; property SessionLog: string read FSessionLog write FSessionLog; + property TermType: string read FTermType write FTermType; end; implementation @@ -111,10 +111,11 @@ begin inherited Create; FSock := TTCPBlockSocket.Create; FSock.OnReadFilter := FilterHook; - FTimeout := 300000; + FTimeout := 60000; FTargetPort := cTelnetProtocol; FSubNeg := ''; FSubType := #0; + FTermType := 'SYNAPSE'; end; destructor TTelnetSend.Destroy; @@ -265,7 +266,7 @@ begin #24: //termtype begin if (FSubNeg <> '') and (FSubNeg[1] = #1) then - SubReply := #0 + 'SYNAPSE'; + SubReply := #0 + FTermType; end; end; Sock.SendString(TLNT_IAC + TLNT_SB + FSubType + SubReply + TLNT_IAC + TLNT_SE);