diff --git a/blcksock.pas b/blcksock.pas
index ab4f4cb..4354752 100644
--- a/blcksock.pas
+++ b/blcksock.pas
@@ -1,9 +1,9 @@
{==============================================================================|
-| Project : Ararat Synapse | 009.000.007 |
+| Project : Ararat Synapse | 009.001.003 |
|==============================================================================|
| Content: Library base |
|==============================================================================|
-| Copyright (c)1999-2005, Lukas Gebauer |
+| Copyright (c)1999-2006, Lukas Gebauer |
| All rights reserved. |
| |
| Redistribution and use in source and binary forms, with or without |
@@ -33,7 +33,7 @@
| DAMAGE. |
|==============================================================================|
| The Initial Developer of the Original Code is Lukas Gebauer (Czech Republic).|
-| Portions created by Lukas Gebauer are Copyright (c)1999-2005. |
+| Portions created by Lukas Gebauer are Copyright (c)1999-2006. |
| All Rights Reserved. |
|==============================================================================|
| Contributor(s): |
@@ -88,16 +88,8 @@ interface
uses
SysUtils, Classes,
-{$IFDEF LINUX}
- {$IFDEF FPC}
synafpc,
- {$ENDIF}
- Libc,
-{$ENDIF}
-{$IFDEF WIN32}
- Windows,
-{$ENDIF}
- synsock, synautil, synacode
+ synsock, synautil, synacode, synaip
{$IFDEF CIL}
,System.Net
,System.Net.Sockets
@@ -107,7 +99,7 @@ uses
const
- SynapseRelease = '36';
+ SynapseRelease = '37';
cLocalhost = '127.0.0.1';
cAnyHost = '0.0.0.0';
@@ -119,8 +111,7 @@ const
CR = #$0d;
LF = #$0a;
CRLF = CR + LF;
- c64k = 65535;
-
+ c64k = 65536;
type
@@ -271,9 +262,9 @@ type
FNonBlockMode: Boolean;
FMaxLineLength: Integer;
FMaxSendBandwidth: Integer;
- FNextSend: ULong;
+ FNextSend: LongWord;
FMaxRecvBandwidth: Integer;
- FNextRecv: ULong;
+ FNextRecv: LongWord;
FConvertLineEnd: Boolean;
FLastCR: Boolean;
FLastLF: Boolean;
@@ -298,10 +289,10 @@ type
procedure SetNonBlockMode(Value: Boolean);
procedure SetTTL(TTL: integer);
function GetTTL:integer;
- function IsNewApi: Boolean;
procedure SetFamily(Value: TSocketFamily); virtual;
procedure SetSocket(Value: TSocket); virtual;
function GetWsaData: TWSAData;
+ function FamilyToAF(f: TSocketFamily): TAddrFamily;
protected
FSocket: TSocket;
FLastError: Integer;
@@ -317,9 +308,10 @@ type
procedure DoReadFilter(Buffer: TMemory; var Len: Integer);
procedure DoMonitor(Writing: Boolean; const Buffer: TMemory; Len: Integer);
procedure DoCreateSocket;
- procedure LimitBandwidth(Length: Integer; MaxB: integer; var Next: ULong);
+ procedure LimitBandwidth(Length: Integer; MaxB: integer; var Next: LongWord);
procedure SetBandwidth(Value: Integer);
function TestStopFlag: Boolean;
+ procedure InternalSendStream(const Stream: TStream; WithSize, Indy: boolean); virtual;
public
constructor Create;
@@ -656,14 +648,6 @@ type
it. (It not supported by all socket providers!)}
procedure SetRecvTimeout(Timeout: Integer);
- {:Convert IPv6 address from their string form to binary. This function
- working only on systems with IPv6 support!}
- function StrToIP6(const value: string): TSockAddrIn6;
-
- {:Convert IPv6 address from binary to string form. This function working
- only on systems with IPv6 support!}
- function IP6ToStr(const value: TSockAddrIn6): string;
-
{:Return value of socket type.}
function GetSocketType: integer; Virtual;
@@ -774,8 +758,8 @@ type
specify if is used IPv4 (dafault - @true) or IPv6.}
property PreferIP4: Boolean read FPreferIP4 Write FPreferIP4;
- {:By dafault (@false) is all timeouts used as timeout between two packets in
- reading operations. If you set this to @true, then Timeouts is for overall
+ {:By default (@true) is all timeouts used as timeout between two packets in
+ reading operations. If you set this to @false, then Timeouts is for overall
reading operation!}
property InterPacketTimeout: Boolean read FInterPacketTimeout Write FInterPacketTimeout;
@@ -1332,9 +1316,9 @@ type
TTL: Byte;
Protocol: Byte;
CheckSum: Word;
- SourceIp: DWORD;
- DestIp: DWORD;
- Options: DWORD;
+ SourceIp: LongWord;
+ DestIp: LongWord;
+ Options: LongWord;
end;
{:@abstract(Parent class of application protocol implementations.)
@@ -1460,11 +1444,16 @@ begin
inherited Destroy;
end;
-function TBlockSocket.IsNewApi: Boolean;
+function TBlockSocket.FamilyToAF(f: TSocketFamily): TAddrFamily;
begin
- Result := SockEnhancedApi;
- if not Result then
- Result := (FFamily = SF_ip6) and SockWship6Api;
+ case f of
+ SF_ip4:
+ Result := AF_INET;
+ SF_ip6:
+ Result := AF_INET6;
+ else
+ Result := AF_UNSPEC;
+ end;
end;
procedure TBlockSocket.SetDelayedOption(const Value: TSynaOption);
@@ -1510,7 +1499,7 @@ begin
begin
FNonBlockMode := Value.Enabled;
x := Ord(FNonBlockMode);
- synsock.IoctlSocket(FSocket, FIONBIO, u_long(x));
+ synsock.IoctlSocket(FSocket, FIONBIO, x);
end;
SOT_RecvTimeout:
begin
@@ -1622,242 +1611,36 @@ begin
end;
procedure TBlockSocket.SetSin(var Sin: TVarSin; IP, Port: string);
-{$IFNDEF CIL}
-type
- pu_long = ^u_long;
var
- ProtoEnt: PProtoEnt;
- ServEnt: PServEnt;
- HostEnt: PHostEnt;
- r: integer;
- Hints1, Hints2: TAddrInfo;
- Sin1, Sin2: TVarSin;
- TwoPass: boolean;
-
- function GetAddr(const IP, port: string; Hints: TAddrInfo; var Sin: TVarSin): integer;
- var
- Addr: PAddrInfo;
- begin
- Addr := nil;
- try
- FillChar(Sin, Sizeof(Sin), 0);
- if Hints.ai_socktype = SOCK_RAW then
- begin
- Hints.ai_socktype := 0;
- Hints.ai_protocol := 0;
- Result := synsock.GetAddrInfo(PChar(IP), nil, @Hints, Addr);
- end
- else
- begin
- if (IP = cAnyHost) or (IP = c6AnyHost) then
- begin
- Hints.ai_flags := AI_PASSIVE;
- Result := synsock.GetAddrInfo(nil, PChar(Port), @Hints, Addr);
- end
- else
- if (IP = cLocalhost) or (IP = c6Localhost) then
- begin
- Result := synsock.GetAddrInfo(nil, PChar(Port), @Hints, Addr);
- end
- else
- begin
- Result := synsock.GetAddrInfo(PChar(IP), PChar(Port), @Hints, Addr);
- end;
- end;
- if Result = 0 then
- if (Addr <> nil) then
- Move(Addr^.ai_addr^, Sin, Addr^.ai_addrlen);
- finally
- if Assigned(Addr) then
- synsock.FreeAddrInfo(Addr);
- end;
- end;
-
+ f: TSocketFamily;
begin
DoStatus(HR_ResolvingBegin, IP + ':' + Port);
FLastError := 0;
- FillChar(Sin, Sizeof(Sin), 0);
- if not IsNewApi then
+ //if socket exists, then use their type, else use users selection
+ f := SF_Any;
+ if (FSocket = INVALID_SOCKET) and (FFamily = SF_any) then
begin
- SynSockCS.Enter;
- try
- Sin.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.sin_port := synsock.htons(StrToIntDef(Port, 0))
- 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
- begin
- HostEnt := synsock.GetHostByName(PChar(IP));
- FLastError := synsock.WSAGetLastError;
- if HostEnt <> nil then
- Sin.sin_addr.S_addr := u_long(Pu_long(HostEnt^.h_addr_list^)^);
- end;
- end;
- finally
- SynSockCS.Leave;
- end;
+ if IsIP(IP) then
+ f := SF_IP4
+ else
+ if IsIP6(IP) then
+ f := SF_IP6;
end
else
- begin
- FillChar(Hints1, Sizeof(Hints1), 0);
- FillChar(Hints2, Sizeof(Hints2), 0);
- TwoPass := False;
- //if socket exists, then use their type, else use users selection
- if FSocket = INVALID_SOCKET then
- case FFamily of
- SF_Any:
- begin
- if IsIP(IP) then
- Hints1.ai_family := AF_INET
- else
- if IsIP6(IP) then
- Hints1.ai_family := AF_INET6
- else
- if FPreferIP4 then
- begin
- Hints1.ai_family := AF_INET;
- Hints2.ai_family := AF_INET6;
- TwoPass := True;
- end
- else
- begin
- Hints2.ai_family := AF_INET;
- Hints1.ai_family := AF_INET6;
- TwoPass := True;
- end
- end;
- SF_IP4:
- Hints1.ai_family := AF_INET;
- SF_IP6:
- Hints1.ai_family := AF_INET6;
- end
- else
- if FIP6Used then
- Hints1.ai_family := AF_INET6
- else
- Hints1.ai_family := AF_INET;
- Hints1.ai_socktype := GetSocketType;
- Hints1.ai_protocol := GetSocketprotocol;
- Hints2.ai_socktype := Hints1.ai_socktype;
- Hints2.ai_protocol := Hints1.ai_protocol;
-
- r := GetAddr(IP, Port, Hints1, Sin1);
- FLastError := r;
- sin := sin1;
- if r <> 0 then
- if TwoPass then
- begin
- r := GetAddr(IP, Port, Hints2, Sin2);
- FLastError := r;
- if r = 0 then
- sin := sin2;
- end;
- end;
-{$ELSE}
-var
- IPs: array of IPAddress;
- n: integer;
- ip4, ip6: string;
- sip: string;
-begin
- ip4 := '';
- ip6 := '';
- IPs := Dns.Resolve(IP).AddressList;
- for n :=low(IPs) to high(IPs) do begin
- if (ip4 = '') and (IPs[n].AddressFamily = AF_INET) then
- ip4 := IPs[n].toString;
- if (ip6 = '') and (IPs[n].AddressFamily = AF_INET6) then
- ip6 := IPs[n].toString;
- if (ip4 <> '') and (ip6 <> '') then
- break;
- end;
- if FSocket = INVALID_SOCKET then
- case FFamily of
- SF_Any:
- begin
- if (ip4 <> '') and (ip6 <> '') then
- begin
- if FPreferIP4 then
- sip := ip4
- else
- Sip := ip6;
- end
- else
- begin
- sip := ip4;
- if (ip6 <> '') then
- sip := ip6;
- end;
- end;
- SF_IP4:
- sip := ip4;
- SF_IP6:
- sip := ip6;
- end
- else
- if FIP6Used then
- sip := ip6
- else
- sip := ip4;
-
- sin := TVarSin.Create(IPAddress.Parse(sip), GetPortService(Port));
-{$ENDIF}
+ f := FFamily;
+ FLastError := synsock.SetVarSin(sin, ip, port, FamilyToAF(f),
+ GetSocketprotocol, GetSocketType, FPreferIP4);
DoStatus(HR_ResolvingEnd, IP + ':' + Port);
end;
function TBlockSocket.GetSinIP(Sin: TVarSin): string;
-{$IFNDEF CIL}
-var
- p: PChar;
- host, serv: string;
- hostlen, servlen: integer;
- r: integer;
begin
- Result := '';
- if not IsNewApi then
- begin
- p := synsock.inet_ntoa(Sin.sin_addr);
- if p <> nil then
- Result := p;
- end
- else
- begin
- hostlen := NI_MAXHOST;
- servlen := NI_MAXSERV;
- setlength(host, hostlen);
- setlength(serv, servlen);
- r := getnameinfo(@sin, SizeOfVarSin(sin), PChar(host), hostlen,
- PChar(serv), servlen, NI_NUMERICHOST + NI_NUMERICSERV);
- if r = 0 then
- Result := PChar(host);
- end;
-{$ELSE}
-begin
- Result := Sin.Address.ToString;
-{$ENDIF}
+ Result := synsock.GetSinIP(sin);
end;
function TBlockSocket.GetSinPort(Sin: TVarSin): Integer;
-{$IFNDEF CIL}
begin
- if (Sin.sin_family = AF_INET6) then
- Result := synsock.ntohs(Sin.sin6_port)
- else
- Result := synsock.ntohs(Sin.sin_port);
-{$ELSE}
-begin
- Result := Sin.Port;
-{$ENDIF}
+ Result := synsock.GetSinPort(sin);
end;
procedure TBlockSocket.CreateSocket;
@@ -2014,10 +1797,10 @@ begin
MaxRecvBandwidth := Value;
end;
-procedure TBlockSocket.LimitBandwidth(Length: Integer; MaxB: integer; var Next: ULong);
+procedure TBlockSocket.LimitBandwidth(Length: Integer; MaxB: integer; var Next: LongWord);
var
- x: ULong;
- y: ULong;
+ x: LongWord;
+ y: LongWord;
begin
if MaxB > 0 then
begin
@@ -2131,22 +1914,30 @@ begin
end;
procedure TBlockSocket.SendBlock(const Data: AnsiString);
+var
+ i: integer;
begin
- SendInteger(Length(data));
- SendString(Data);
+ i := SwapBytes(Length(data));
+ SendString(Codelongint(i) + Data);
end;
-procedure TBlockSocket.SendStreamRaw(const Stream: TStream);
+procedure TBlockSocket.InternalSendStream(const Stream: TStream; WithSize, Indy: boolean);
var
- si: integer;
+ si, l: integer;
x, y, yr: integer;
s: AnsiString;
+ b: boolean;
{$IFDEF CIL}
buf: TMemory;
{$ENDIF}
begin
si := Stream.Size - Stream.Position;
+ if not indy then
+ l := SwapBytes(si)
+ else
+ l := si;
x := 0;
+ b := true;
while x < si do
begin
y := si - x;
@@ -2157,6 +1948,11 @@ begin
yr := Stream.read(buf, y);
if yr > 0 then
begin
+ if WithSize and b then
+ begin
+ b := false;
+ SendString(CodeLongInt(l));
+ end;
SendBuffer(buf, yr);
if FLastError <> 0 then
break;
@@ -2170,7 +1966,13 @@ begin
if yr > 0 then
begin
SetLength(s, yr);
- SendString(s);
+ if WithSize and b then
+ begin
+ b := false;
+ SendString(CodeLongInt(l) + s);
+ end
+ else
+ SendString(s);
if FLastError <> 0 then
break;
Inc(x, yr);
@@ -2181,23 +1983,19 @@ begin
end;
end;
-procedure TBlockSocket.SendStreamIndy(const Stream: TStream);
-var
- si: integer;
+procedure TBlockSocket.SendStreamRaw(const Stream: TStream);
begin
- si := Stream.Size - Stream.Position;
- si := synsock.HToNL(si);
- SendInteger(si);
- SendStreamRaw(Stream);
+ InternalSendStream(Stream, false, false);
+end;
+
+procedure TBlockSocket.SendStreamIndy(const Stream: TStream);
+begin
+ InternalSendStream(Stream, true, true);
end;
procedure TBlockSocket.SendStream(const Stream: TStream);
-var
- si: integer;
begin
- si := Stream.Size - Stream.Position;
- SendInteger(si);
- SendStreamRaw(Stream);
+ InternalSendStream(Stream, true, false);
end;
function TBlockSocket.RecvBuffer(Buffer: TMemory; Length: Integer): Integer;
@@ -2213,10 +2011,13 @@ begin
else
SockCheck(Result);
ExceptCheck;
- Inc(FRecvCounter, Result);
- DoStatus(HR_ReadCount, IntToStr(Result));
- DoMonitor(False, Buffer, Result);
- DoReadFilter(Buffer, Result);
+ if Result > 0 then
+ begin
+ Inc(FRecvCounter, Result);
+ DoStatus(HR_ReadCount, IntToStr(Result));
+ DoMonitor(False, Buffer, Result);
+ DoReadFilter(Buffer, Result);
+ end;
end;
function TBlockSocket.RecvBufferEx(Buffer: TMemory; Len: Integer;
@@ -2224,45 +2025,49 @@ function TBlockSocket.RecvBufferEx(Buffer: TMemory; Len: Integer;
var
s: AnsiString;
rl, l: integer;
- ti: ULong;
+ ti: LongWord;
{$IFDEF CIL}
n: integer;
b: TMemory;
{$ENDIF}
begin
FLastError := 0;
- rl := 0;
- repeat
- ti := GetTick;
- s := RecvPacket(Timeout);
- l := Length(s);
- if (rl + l) > Len then
- l := Len - rl;
- {$IFDEF CIL}
- b := BytesOf(s);
- for n := 0 to l do
- Buffer[rl + n] := b[n];
- {$ELSE}
- Move(Pointer(s)^, IncPoint(Buffer, rl)^, l);
- {$ENDIF}
- rl := rl + l;
- if FLastError <> 0 then
- Break;
- if rl >= Len then
- Break;
- if not FInterPacketTimeout then
- begin
- Timeout := Timeout - integer(TickDelta(ti, GetTick));
- if Timeout <= 0 then
- begin
- FLastError := WSAETIMEDOUT;
+ Result := 0;
+ if Len > 0 then
+ begin
+ rl := 0;
+ repeat
+ ti := GetTick;
+ s := RecvPacket(Timeout);
+ l := Length(s);
+ if (rl + l) > Len then
+ l := Len - rl;
+ {$IFDEF CIL}
+ b := BytesOf(s);
+ for n := 0 to l do
+ Buffer[rl + n] := b[n];
+ {$ELSE}
+ Move(Pointer(s)^, IncPoint(Buffer, rl)^, l);
+ {$ENDIF}
+ rl := rl + l;
+ if FLastError <> 0 then
Break;
+ if rl >= Len then
+ Break;
+ if not FInterPacketTimeout then
+ begin
+ Timeout := Timeout - integer(TickDelta(ti, GetTick));
+ if Timeout <= 0 then
+ begin
+ FLastError := WSAETIMEDOUT;
+ Break;
+ end;
end;
- end;
- until False;
- delete(s, 1, l);
- FBuffer := s;
- Result := rl;
+ until False;
+ delete(s, 1, l);
+ FBuffer := s;
+ Result := rl;
+ end;
end;
function TBlockSocket.RecvBufferStr(Length: Integer; Timeout: Integer): AnsiString;
@@ -2312,8 +2117,10 @@ begin
end
else
begin
+ {$IFDEF WIN32}
//not drain CPU on large downloads...
Sleep(0);
+ {$ENDIF}
x := WaitingData;
if x > 0 then
begin
@@ -2361,6 +2168,15 @@ begin
FLastError := WSAETIMEDOUT;
end;
end;
+ if FConvertLineEnd and (Result <> '') then
+ begin
+ if FLastCR and (Result[1] = LF) then
+ Delete(Result, 1, 1);
+ if FLastLF and (Result[1] = CR) then
+ Delete(Result, 1, 1);
+ FLastCR := False;
+ FLastLF := False;
+ end;
ExceptCheck;
end;
@@ -2397,7 +2213,7 @@ var
CorCRLF: Boolean;
t: AnsiString;
tl: integer;
- ti: ULong;
+ ti: LongWord;
begin
FLastError := 0;
Result := '';
@@ -2418,12 +2234,6 @@ begin
if Length(s) > 0 then
if CorCRLF then
begin
- if FLastCR and (s[1] = LF) then
- Delete(s, 1, 1);
- if FLastLF and (s[1] = CR) then
- Delete(s, 1, 1);
- FLastCR := False;
- FLastLF := False;
t := '';
x := PosCRLF(s, t);
tl := Length(t);
@@ -2623,8 +2433,10 @@ var
x: Integer;
begin
Result := 0;
- if synsock.IoctlSocket(FSocket, FIONREAD, u_long(x)) = 0 then
+ if synsock.IoctlSocket(FSocket, FIONREAD, x) = 0 then
Result := x;
+ if Result > c64k then
+ Result := c64k;
end;
function TBlockSocket.WaitingDataEx: Integer;
@@ -2640,7 +2452,11 @@ begin
Sleep(1);
try
while (Length(FBuffer) > 0) or (WaitingData > 0) do
+ begin
RecvPacket(0);
+ if FLastError <> 0 then
+ break;
+ end;
except
on exception do;
end;
@@ -2665,116 +2481,13 @@ begin
Result := '127.0.0.1';
end;
-{$IFDEF CIL}
procedure TBlockSocket.ResolveNameToIP(Name: string; const IPList: TStrings);
-var
- IPs :array of IPAddress;
- n: integer;
begin
IPList.Clear;
- IPs := Dns.Resolve(Name).AddressList;
- for n := low(IPs) to high(IPs) do
- begin
- if not(((FFamily = SF_IP6) and (IPs[n].AddressFamily = AF_INET))
- or ((FFamily = SF_IP4) and (IPs[n].AddressFamily = AF_INET6))) then
- begin
- IPList.Add(IPs[n].toString);
- end;
- end;
-end;
-
-{$ELSE}
-procedure TBlockSocket.ResolveNameToIP(Name: string; const IPList: TStrings);
-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;
- i: Integer;
- s: string;
- InAddr: TInAddr;
-begin
- IPList.Clear;
- if not IsNewApi then
- begin
- 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
- 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;
- end
- else
- IPList.Add(Name);
- 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(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;
+ synsock.ResolveNameToIP(Name, FamilyToAF(FFamily), GetSocketprotocol, GetSocketType, IPList);
if IPList.Count = 0 then
IPList.Add(cAnyHost);
end;
-{$ENDIF}
function TBlockSocket.ResolveName(Name: string): string;
var
@@ -2790,123 +2503,16 @@ begin
end;
function TBlockSocket.ResolvePort(Port: string): Word;
-{$IFDEF CIL}
begin
- Result := SynSock.GetPortService(Port);
+ Result := synsock.ResolvePort(Port, FamilyToAF(FFamily), GetSocketProtocol, GetSocketType);
end;
-{$ELSE}
-var
- ProtoEnt: PProtoEnt;
- ServEnt: PServEnt;
- Hints: TAddrInfo;
- Addr: PAddrInfo;
- r: integer;
-begin
- 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 := StrToIntDef(Port, 0)
- else
- Result := synsock.htons(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) and Assigned(Addr) 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;
-{$ENDIF}
-{$IFDEF CIL}
function TBlockSocket.ResolveIPToName(IP: string): string;
begin
- Result := Dns.GetHostByAddress(IP).HostName;
+ if not IsIP(IP) or not IsIp6(IP) then
+ IP := ResolveName(IP);
+ Result := synsock.ResolveIPToName(IP, FamilyToAF(FFamily), GetSocketProtocol, GetSocketType);
end;
-{$ELSE}
-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) and Assigned(Addr)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;
-{$ENDIF}
procedure TBlockSocket.SetRemoteSin(IP, Port: string);
begin
@@ -3004,7 +2610,7 @@ begin
Exit;
DoMonitor(True, Buffer, Length);
LimitBandwidth(Length, FMaxSendBandwidth, FNextsend);
- Result := synsock.SendTo(FSocket, Buffer, Length, 0, FRemoteSin);
+ Result := synsock.SendTo(FSocket, Buffer, Length, MSG_NOSIGNAL, FRemoteSin);
SockCheck(Result);
ExceptCheck;
Inc(FSendCounter, Result);
@@ -3017,7 +2623,7 @@ begin
if TestStopFlag then
Exit;
LimitBandwidth(Length, FMaxRecvBandwidth, FNextRecv);
- Result := synsock.RecvFrom(FSocket, Buffer, Length, 0, FRemoteSin);
+ Result := synsock.RecvFrom(FSocket, Buffer, Length, MSG_NOSIGNAL, FRemoteSin);
SockCheck(Result);
ExceptCheck;
Inc(FRecvCounter, Result);
@@ -3212,107 +2818,6 @@ begin
FIP6Used := FRemoteSin.AddressFamily = AF_INET6;
end;
-{$IFDEF CIL}
-function TBlockSocket.StrToIP6(const value: string): TSockAddrIn6;
-var
- buf: TMemory;
- IP: IPAddress;
-begin
- IP := IPAddress.Parse(Value);
- buf := IP.GetAddressBytes;
- result.sin6_addr.S_un_b.s_b1 := char(buf[0]);
- result.sin6_addr.S_un_b.s_b2 := char(buf[1]);
- result.sin6_addr.S_un_b.s_b3 := char(buf[2]);
- result.sin6_addr.S_un_b.s_b4 := char(buf[3]);
- result.sin6_addr.S_un_b.s_b5 := char(buf[4]);
- result.sin6_addr.S_un_b.s_b6 := char(buf[5]);
- result.sin6_addr.S_un_b.s_b7 := char(buf[6]);
- result.sin6_addr.S_un_b.s_b8 := char(buf[7]);
- result.sin6_addr.S_un_b.s_b9 := char(buf[8]);
- result.sin6_addr.S_un_b.s_b10 := char(buf[9]);
- result.sin6_addr.S_un_b.s_b11 := char(buf[10]);
- result.sin6_addr.S_un_b.s_b12 := char(buf[11]);
- result.sin6_addr.S_un_b.s_b13 := char(buf[12]);
- result.sin6_addr.S_un_b.s_b14 := char(buf[13]);
- result.sin6_addr.S_un_b.s_b15 := char(buf[14]);
- result.sin6_addr.S_un_b.s_b16 := char(buf[15]);
- result.sin6_family := Word(AF_INET6);
-end;
-{$ELSE}
-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) and Assigned(Addr) 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;
-{$ENDIF}
-
-{$IFDEF CIL}
-function TBlockSocket.IP6ToStr(const value: TSockAddrIn6): string;
-var
- buf: TMemory;
- IP: IPAddress;
-begin
- setlength(buf, 16);
- buf[0] := byte(value.sin6_addr.S_un_b.s_b1);
- buf[1] := byte(value.sin6_addr.S_un_b.s_b2);
- buf[2] := byte(value.sin6_addr.S_un_b.s_b3);
- buf[3] := byte(value.sin6_addr.S_un_b.s_b4);
- buf[4] := byte(value.sin6_addr.S_un_b.s_b5);
- buf[5] := byte(value.sin6_addr.S_un_b.s_b6);
- buf[6] := byte(value.sin6_addr.S_un_b.s_b7);
- buf[7] := byte(value.sin6_addr.S_un_b.s_b8);
- buf[8] := byte(value.sin6_addr.S_un_b.s_b9);
- buf[9] := byte(value.sin6_addr.S_un_b.s_b10);
- buf[10] := byte(value.sin6_addr.S_un_b.s_b11);
- buf[11] := byte(value.sin6_addr.S_un_b.s_b12);
- buf[12] := byte(value.sin6_addr.S_un_b.s_b13);
- buf[13] := byte(value.sin6_addr.S_un_b.s_b14);
- buf[14] := byte(value.sin6_addr.S_un_b.s_b15);
- buf[15] := byte(value.sin6_addr.S_un_b.s_b16);
- IP := IPAddress.Create(buf);
- Result := IP.ToString;
-end;
-{$ELSE}
-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;
-{$ENDIF}
-
function TBlockSocket.GetWsaData: TWSAData;
begin
Result := WsaDataOnce;
@@ -3648,8 +3153,8 @@ end;
function TSocksBlockSocket.SocksCode(IP, Port: string): string;
var
- s: string;
- ip6: TSockAddrIn6;
+ ip6: TIp6Bytes;
+ n: integer;
begin
if FSocksType <> ST_Socks5 then
begin
@@ -3678,24 +3183,9 @@ begin
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;
+ Result := #4;
+ for n := 0 to 15 do
+ Result := Result + char(ip6[n]);
end
else
Result := #3 + char(Length(IP)) + IP;
@@ -3708,7 +3198,7 @@ var
Atyp: Byte;
y, n: integer;
w: Word;
- ip6: TSockAddrIn6;
+ ip6: TIp6Bytes;
begin
FSocksResponsePort := '0';
Result := 0;
@@ -3751,26 +3241,8 @@ begin
begin
if Length(Value) < 22 then
Exit;
- 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 := word(AF_INET6);
- ip6.sin6_port := 0;
- ip6.sin6_flowinfo := 0;
- ip6.sin6_scope_id := 0;
+ for n := 0 to 15 do
+ ip6[n] := ord(Value[n + 5]);
FSocksResponseIP := IP6ToStr(ip6);
Result := 21;
end;
@@ -3913,18 +3385,22 @@ procedure TUDPBlockSocket.AddMulticast(MCastIP: string);
var
Multicast: TIP_mreq;
Multicast6: TIPv6_mreq;
+ n: integer;
+ ip6: Tip6bytes;
begin
if FIP6Used then
begin
- Multicast6.ipv6mr_multiaddr := StrToIp6(MCastIP).sin6_addr;
+ ip6 := StrToIp6(MCastIP);
+ for n := 0 to 15 do
+ Multicast6.ipv6mr_multiaddr.u6_addr8[n] := Ip6[n];
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);
+ Multicast.imr_multiaddr.S_addr := strtoip(MCastIP);
+ Multicast.imr_interface.S_addr := INADDR_ANY;
SockCheck(synsock.SetSockOpt(FSocket, IPPROTO_IP, IP_ADD_MEMBERSHIP,
pchar(@Multicast), SizeOf(Multicast)));
end;
@@ -3935,18 +3411,22 @@ procedure TUDPBlockSocket.DropMulticast(MCastIP: string);
var
Multicast: TIP_mreq;
Multicast6: TIPv6_mreq;
+ n: integer;
+ ip6: Tip6bytes;
begin
if FIP6Used then
begin
- Multicast6.ipv6mr_multiaddr := StrToIp6(MCastIP).sin6_addr;
+ ip6 := StrToIp6(MCastIP);
+ for n := 0 to 15 do
+ Multicast6.ipv6mr_multiaddr.u6_addr8[n] := Ip6[n];
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);
+ Multicast.imr_multiaddr.S_addr := strtoip(MCastIP);
+ Multicast.imr_interface.S_addr := INADDR_ANY;
SockCheck(synsock.SetSockOpt(FSocket, IPPROTO_IP, IP_DROP_MEMBERSHIP,
pchar(@Multicast), SizeOf(Multicast)));
end;
@@ -4038,7 +3518,7 @@ end;
function TTCPBlockSocket.WaitingData: Integer;
begin
Result := 0;
- if FSSL.SSLEnabled then
+ if FSSL.SSLEnabled and (FSocket <> INVALID_SOCKET) then
Result := FSSL.WaitingData;
if Result = 0 then
Result := inherited WaitingData;
diff --git a/clamsend.pas b/clamsend.pas
new file mode 100644
index 0000000..81dd5f6
--- /dev/null
+++ b/clamsend.pas
@@ -0,0 +1,218 @@
+{==============================================================================|
+| Project : Ararat Synapse | 001.000.000 |
+|==============================================================================|
+| Content: ClamAV-daemon client |
+|==============================================================================|
+| Copyright (c)2005, Lukas Gebauer |
+| All rights reserved. |
+| |
+| Redistribution and use in source and binary forms, with or without |
+| modification, are permitted provided that the following conditions are met: |
+| |
+| Redistributions of source code must retain the above copyright notice, this |
+| list of conditions and the following disclaimer. |
+| |
+| Redistributions in binary form must reproduce the above copyright notice, |
+| this list of conditions and the following disclaimer in the documentation |
+| and/or other materials provided with the distribution. |
+| |
+| Neither the name of Lukas Gebauer nor the names of its contributors may |
+| be used to endorse or promote products derived from this software without |
+| specific prior written permission. |
+| |
+| THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" |
+| AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE |
+| IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE |
+| ARE DISCLAIMED. IN NO EVENT SHALL THE REGENTS OR CONTRIBUTORS BE LIABLE FOR |
+| ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL |
+| DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR |
+| SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER |
+| CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT |
+| LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY |
+| OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH |
+| DAMAGE. |
+|==============================================================================|
+| The Initial Developer of the Original Code is Lukas Gebauer (Czech Republic).|
+| Portions created by Lukas Gebauer are Copyright (c)2003. |
+| All Rights Reserved. |
+|==============================================================================|
+| Contributor(s): |
+|==============================================================================|
+| History: see HISTORY.HTM from distribution package |
+| (Found at URL: http://www.ararat.cz/synapse/) |
+|==============================================================================}
+
+{:@abstract( ClamAV-daemon client)
+
+This unit is capable to do antivirus scan of your data by TCP channel to ClamD
+daemon from ClamAV. See more about ClamAV on @LINK(http://www.clamav.net)
+}
+
+{$IFDEF FPC}
+ {$MODE DELPHI}
+{$ENDIF}
+{$Q-}
+{$H+}
+
+unit clamsend;
+
+interface
+
+uses
+ SysUtils, Classes,
+ synsock, blcksock, synautil;
+
+const
+ cClamProtocol = '3310';
+
+type
+
+ {:@abstract(Implementation of ClamAV-daemon client protocol)
+ By this class you can scan any your data by ClamAV opensource antivirus.
+
+ This class can connect to ClamD by TCP channel, send your data to ClamD
+ and read result.}
+ TClamSend = class(TSynaClient)
+ private
+ FSock: TTCPBlockSocket;
+ FDSock: TTCPBlockSocket;
+ FSession: boolean;
+ function Login: boolean; virtual;
+ function Logout: Boolean; virtual;
+ function OpenStream: Boolean; virtual;
+ public
+ constructor Create;
+ destructor Destroy; override;
+
+ {:Call any command to ClamD. Used internally by other methods.}
+ function DoCommand(const Value: AnsiString): AnsiString; virtual;
+
+ {:Return ClamAV version and version of loaded databases.}
+ function GetVersion: AnsiString; virtual;
+
+ {:Scan content of TStrings.}
+ function ScanStrings(const Value: TStrings): AnsiString; virtual;
+
+ {:Scan content of TStream.}
+ function ScanStream(const Value: TStream): AnsiString; virtual;
+ published
+ {:Socket object used for TCP/IP operation. Good for seting OnStatus hook, etc.}
+ property Sock: TTCPBlockSocket read FSock;
+
+ {:Socket object used for TCP data transfer operation. Good for seting OnStatus hook, etc.}
+ property DSock: TTCPBlockSocket read FDSock;
+
+ {:Can turn-on session mode of communication with ClamD. Default is @false,
+ because ClamAV developers design their TCP code very badly and session mode
+ is broken now (CVS-20051031). Maybe ClamAV developers fix their bugs
+ and this mode will be possible in future.}
+ property Session: boolean read FSession write FSession;
+ end;
+
+implementation
+
+constructor TClamSend.Create;
+begin
+ inherited Create;
+ FSock := TTCPBlockSocket.Create;
+ FDSock := TTCPBlockSocket.Create;
+ FTimeout := 60000;
+ FTargetPort := cClamProtocol;
+ FSession := false;
+end;
+
+destructor TClamSend.Destroy;
+begin
+ Logout;
+ FDSock.Free;
+ FSock.Free;
+ inherited Destroy;
+end;
+
+function TClamSend.DoCommand(const Value: AnsiString): AnsiString;
+begin
+ Result := '';
+ if not FSession then
+ FSock.CloseSocket
+ else
+ FSock.SendString(Value + LF);
+ if not FSession or (FSock.LastError <> 0) then
+ begin
+ if Login then
+ FSock.SendString(Value + LF)
+ else
+ Exit;
+ end;
+ Result := FSock.RecvTerminated(FTimeout, LF);
+end;
+
+function TClamSend.Login: boolean;
+begin
+ Result := False;
+ Sock.CloseSocket;
+ FSock.Bind(FIPInterface, cAnyPort);
+ if FSock.LastError <> 0 then
+ Exit;
+ FSock.Connect(FTargetHost, FTargetPort);
+ if FSock.LastError <> 0 then
+ Exit;
+ if FSession then
+ FSock.SendString('SESSION' + LF);
+ Result := FSock.LastError = 0;
+end;
+
+function TClamSend.Logout: Boolean;
+begin
+ FSock.SendString('END' + LF);
+ Result := FSock.LastError = 0;
+ FSock.CloseSocket;
+end;
+
+function TClamSend.GetVersion: AnsiString;
+begin
+ Result := DoCommand('VERSION');
+end;
+
+function TClamSend.OpenStream: Boolean;
+var
+ S: AnsiString;
+begin
+ Result := False;
+ s := DoCommand('STREAM');
+ if (s <> '') and (Copy(s, 1, 4) = 'PORT') then
+ begin
+ s := SeparateRight(s, ' ');
+ FDSock.CloseSocket;
+ FDSock.Bind(FIPInterface, cAnyPort);
+ if FDSock.LastError <> 0 then
+ Exit;
+ FDSock.Connect(FTargetHost, s);
+ if FDSock.LastError <> 0 then
+ Exit;
+ Result := True;
+ end;
+end;
+
+function TClamSend.ScanStrings(const Value: TStrings): AnsiString;
+begin
+ Result := '';
+ if OpenStream then
+ begin
+ DSock.SendString(Value.Text);
+ DSock.CloseSocket;
+ Result := FSock.RecvTerminated(FTimeout, LF);
+ end;
+end;
+
+function TClamSend.ScanStream(const Value: TStream): AnsiString;
+begin
+ Result := '';
+ if OpenStream then
+ begin
+ DSock.SendStreamRaw(Value);
+ DSock.CloseSocket;
+ Result := FSock.RecvTerminated(FTimeout, LF);
+ end;
+end;
+
+end.
diff --git a/dnssend.pas b/dnssend.pas
index 2e21865..16f0cb9 100644
--- a/dnssend.pas
+++ b/dnssend.pas
@@ -1,5 +1,5 @@
{==============================================================================|
-| Project : Ararat Synapse | 002.007.000 |
+| Project : Ararat Synapse | 002.007.003 |
|==============================================================================|
| Content: DNS client |
|==============================================================================|
@@ -60,7 +60,7 @@ interface
uses
SysUtils, Classes,
- blcksock, synautil, synsock;
+ blcksock, synautil, synaip, synsock;
const
cDnsProtocol = 'domain';
@@ -120,13 +120,11 @@ type
FSock: TUDPBlockSocket;
FTCPSock: TTCPBlockSocket;
FUseTCP: Boolean;
- FAnsferInfo: TStringList;
+ FAnswerInfo: TStringList;
FNameserverInfo: TStringList;
FAdditionalInfo: TStringList;
FAuthoritative: Boolean;
FTruncated: Boolean;
- function ReverseIP(Value: AnsiString): AnsiString;
- function ReverseIP6(Value: AnsiString): AnsiString;
function CompressName(const Value: AnsiString): AnsiString;
function CodeHeader: AnsiString;
function CodeQuery(const Name: AnsiString; QType: Integer): AnsiString;
@@ -177,16 +175,16 @@ type
4-not implemented, 5-refused.}
property RCode: Integer read FRCode;
- {:@True, if ansfer is authoritative.}
+ {:@True, if answer is authoritative.}
property Authoritative: Boolean read FAuthoritative;
- {:@True, if ansfer is truncated to 512 bytes.}
+ {:@True, if answer is truncated to 512 bytes.}
property Truncated: Boolean read FTRuncated;
{:Detailed informations from name server reply. One record per line. Record
have comma delimited entries with type number, TTL and data filelds.
This information contains detailed information about query reply.}
- property AnsferInfo: TStringList read FAnsferInfo;
+ property AnswerInfo: TStringList read FAnswerInfo;
{:Detailed informations from name server reply. One record per line. Record
have comma delimited entries with type number, TTL and data filelds.
@@ -218,7 +216,7 @@ begin
FUseTCP := False;
FTimeout := 10000;
FTargetPort := cDnsProtocol;
- FAnsferInfo := TStringList.Create;
+ FAnswerInfo := TStringList.Create;
FNameserverInfo := TStringList.Create;
FAdditionalInfo := TStringList.Create;
Randomize;
@@ -226,7 +224,7 @@ end;
destructor TDNSSend.Destroy;
begin
- FAnsferInfo.Free;
+ FAnswerInfo.Free;
FNameserverInfo.Free;
FAdditionalInfo.Free;
FTCPSock.Free;
@@ -234,44 +232,6 @@ begin
inherited Destroy;
end;
-function TDNSSend.ReverseIP(Value: AnsiString): AnsiString;
-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: AnsiString): AnsiString;
-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: AnsiString): AnsiString;
var
n: Integer;
@@ -363,7 +323,7 @@ var
RType, Len, j, x, y, z, n: Integer;
R: AnsiString;
t1, t2, ttl: integer;
- ip6: TSockAddrIn6;
+ ip6: TIp6bytes;
begin
Result := '';
R := '';
@@ -393,28 +353,9 @@ begin
end;
QTYPE_AAAA:
begin
-// FillChar(ip6, SizeOf(ip6), 0);
- ip6.sin6_addr.S_un_b.s_b1 := Char(FBuffer[j]);
- ip6.sin6_addr.S_un_b.s_b2 := Char(FBuffer[j + 1]);
- ip6.sin6_addr.S_un_b.s_b3 := Char(FBuffer[j + 2]);
- ip6.sin6_addr.S_un_b.s_b4 := Char(FBuffer[j + 3]);
- ip6.sin6_addr.S_un_b.s_b5 := Char(FBuffer[j + 4]);
- ip6.sin6_addr.S_un_b.s_b6 := Char(FBuffer[j + 5]);
- ip6.sin6_addr.S_un_b.s_b7 := Char(FBuffer[j + 6]);
- ip6.sin6_addr.S_un_b.s_b8 := Char(FBuffer[j + 7]);
- ip6.sin6_addr.S_un_b.s_b9 := Char(FBuffer[j + 8]);
- ip6.sin6_addr.S_un_b.s_b10 := Char(FBuffer[j + 9]);
- ip6.sin6_addr.S_un_b.s_b11 := Char(FBuffer[j + 10]);
- ip6.sin6_addr.S_un_b.s_b12 := Char(FBuffer[j + 11]);
- ip6.sin6_addr.S_un_b.s_b13 := Char(FBuffer[j + 12]);
- ip6.sin6_addr.S_un_b.s_b14 := Char(FBuffer[j + 13]);
- ip6.sin6_addr.S_un_b.s_b15 := Char(FBuffer[j + 14]);
- ip6.sin6_addr.S_un_b.s_b16 := Char(FBuffer[j + 15]);
- ip6.sin6_family := word(AF_INET6);
- ip6.sin6_port := 0;
- ip6.sin6_flowinfo := 0;
- ip6.sin6_scope_id := 0;
- R := FSock.IP6ToStr(ip6);
+ for n := 0 to 15 do
+ ip6[n] := ord(FBuffer[j + n]);
+ R := IP6ToStr(ip6);
end;
QTYPE_NS, QTYPE_MD, QTYPE_MF, QTYPE_CNAME, QTYPE_MB,
QTYPE_MG, QTYPE_MR, QTYPE_PTR, QTYPE_X25, QTYPE_NSAP,
@@ -514,7 +455,7 @@ var
begin
Result := False;
Reply.Clear;
- FAnsferInfo.Clear;
+ FAnswerInfo.Clear;
FNameserverInfo.Clear;
FAdditionalInfo.Clear;
FAuthoritative := False;
@@ -542,7 +483,7 @@ begin
if (ancount > 0) and (Length(Buf) > i) then // decode reply
for n := 1 to ancount do
begin
- s := DecodeResource(i, FAnsferInfo, QType);
+ s := DecodeResource(i, FAnswerInfo, QType);
if s <> '' then
Reply.Add(s);
end;
@@ -588,11 +529,11 @@ begin
try
repeat
b := DecodeResponse(FBuffer, Reply, QType);
- if (t.Count > 1) and (AnsferInfo.Count > 0) then //find end of transfer
- b := b and (t[0] <> AnsferInfo[AnsferInfo.count - 1]);
+ if (t.Count > 1) and (AnswerInfo.Count > 0) then //find end of transfer
+ b := b and (t[0] <> AnswerInfo[AnswerInfo.count - 1]);
if b then
begin
- t.AddStrings(AnsferInfo);
+ t.AddStrings(AnswerInfo);
FBuffer := RecvTCPResponse(WorkSock);
if FBuffer = '' then
Break;
diff --git a/ftpsend.pas b/ftpsend.pas
index 1c1ff1c..2ec6f7f 100644
--- a/ftpsend.pas
+++ b/ftpsend.pas
@@ -1,5 +1,5 @@
{==============================================================================|
-| Project : Ararat Synapse | 003.004.005 |
+| Project : Ararat Synapse | 003.004.008 |
|==============================================================================|
| Content: FTP client |
|==============================================================================|
@@ -59,7 +59,7 @@ interface
uses
SysUtils, Classes,
- blcksock, synautil, synsock;
+ blcksock, synautil, synaip, synsock;
const
cFtpProtocol = 'ftp';
@@ -1220,6 +1220,7 @@ begin
//VMS
FMasks.add('v*$ DD TTT YYYY hh mm');
FMasks.add('v*$!DD TTT YYYY hh mm');
+ FMasks.add('n*$ YYYY MM DD hh mm$S*');
//AS400
FMasks.add('!S*$MM DD YY hh mm ss !n*');
FMasks.add('!S*$DD MM YY hh mm ss !n*');
@@ -1246,7 +1247,7 @@ begin
//tandem
FMasks.add('nnnnnnnn SSSSSSS DD TTT YY hh mm ss');
//MVS
- FMasks.add('- YYYY MM DD SSSSS d=O n*');
+ FMasks.add('- YYYY MM DD SSSSS d=O n*');
//BullGCOS8
FMasks.add(' $S* MM DD YY hh mm ss !n*');
FMasks.add('d $S* MM DD YY !n*');
@@ -1738,14 +1739,14 @@ begin
if Value[1] = '+' then
begin
os := Value;
+ Delete(Value, 1, 1);
flr := TFTPListRec.create;
+ flr.FileName := SeparateRight(Value, #9);
s := Fetch(Value, ',');
while s <> '' do
begin
if s[1] = #9 then
- begin
- flr.FileName := Copy(s, 2, Length(s) - 1);
- end;
+ Break;
case s[1] of
'/':
flr.Directory := true;
diff --git a/httpsend.pas b/httpsend.pas
index 2e9e937..b23812d 100644
--- a/httpsend.pas
+++ b/httpsend.pas
@@ -1,9 +1,9 @@
{==============================================================================|
-| Project : Ararat Synapse | 003.010.001 |
+| Project : Ararat Synapse | 003.010.005 |
|==============================================================================|
| Content: HTTP client |
|==============================================================================|
-| Copyright (c)1999-2005, Lukas Gebauer |
+| Copyright (c)1999-2006, Lukas Gebauer |
| All rights reserved. |
| |
| Redistribution and use in source and binary forms, with or without |
@@ -33,7 +33,7 @@
| DAMAGE. |
|==============================================================================|
| The Initial Developer of the Original Code is Lukas Gebauer (Czech Republic).|
-| Portions created by Lukas Gebauer are Copyright (c) 1999-2005. |
+| Portions created by Lukas Gebauer are Copyright (c) 1999-2006. |
| All Rights Reserved. |
|==============================================================================|
| Contributor(s): |
@@ -58,7 +58,7 @@ interface
uses
SysUtils, Classes,
- blcksock, synautil, synacode;
+ blcksock, synautil, synaip, synacode, synsock;
const
cHttpProtocol = '80';
@@ -97,6 +97,9 @@ type
function ReadIdentity(Size: Integer): Boolean;
function ReadChunked: Boolean;
procedure ParseCookies;
+ function PrepareHeaders: string;
+ function InternalDoConnect(needssl: Boolean): Boolean;
+ function InternalConnect(needssl: Boolean): Boolean;
public
constructor Create;
destructor Destroy; override;
@@ -302,6 +305,51 @@ begin
FResultString := '';
end;
+function THTTPSend.PrepareHeaders: string;
+begin
+ if FProtocol = '0.9' then
+ Result := FHeaders[0] + CRLF
+ else
+{$IFNDEF WIN32}
+ Result := AdjustLineBreaks(FHeaders.Text, tlbsCRLF);
+{$ELSE}
+ Result := FHeaders.Text;
+{$ENDIF}
+end;
+
+function THTTPSend.InternalDoConnect(needssl: Boolean): Boolean;
+begin
+ Result := False;
+ FSock.CloseSocket;
+ FSock.Bind(FIPInterface, cAnyPort);
+ if FSock.LastError <> 0 then
+ Exit;
+ FSock.Connect(FTargetHost, FTargetPort);
+ if FSock.LastError <> 0 then
+ Exit;
+ if needssl then
+ begin
+ FSock.SSLDoConnect;
+ if FSock.LastError <> 0 then
+ Exit;
+ end;
+ FAliveHost := FTargetHost;
+ FAlivePort := FTargetPort;
+ Result := True;
+end;
+
+function THTTPSend.InternalConnect(needssl: Boolean): Boolean;
+begin
+ if FSock.Socket = INVALID_SOCKET then
+ Result := InternalDoConnect(needssl)
+ else
+ if (FAliveHost <> FTargetHost) or (FAlivePort <> FTargetPort)
+ or FSock.CanRead(0) then
+ Result := InternalDoConnect(needssl)
+ else
+ Result := True;
+end;
+
function THTTPSend.HTTPMethod(const Method, URL: string): Boolean;
var
Sending, Receiving: Boolean;
@@ -344,14 +392,14 @@ begin
FSock.HTTPTunnelPass := '';
end;
- Sending := Document.Size > 0;
+ Sending := FDocument.Size > 0;
{Headers for Sending data}
status100 := FStatus100 and Sending and (FProtocol = '1.1');
if status100 then
FHeaders.Insert(0, 'Expect: 100-continue');
- FHeaders.Insert(0, 'Content-Length: ' + IntToStr(FDocument.Size));
if Sending then
begin
+ FHeaders.Insert(0, 'Content-Length: ' + IntToStr(FDocument.Size));
if FMimeType <> '' then
FHeaders.Insert(0, 'Content-Type: ' + FMimeType);
end;
@@ -415,91 +463,68 @@ begin
FHeaders.Add('');
{ connect }
- if (FAliveHost <> FTargetHost) or (FAlivePort <> FTargetPort) then
+ if not InternalConnect(UpperCase(Prot) = 'HTTPS') then
begin
FSock.CloseSocket;
- FSock.Bind(FIPInterface, cAnyPort);
- if FSock.LastError <> 0 then
- Exit;
- if FSock.LastError <> 0 then
- Exit;
- FSock.Connect(FTargetHost, FTargetPort);
- if FSock.LastError <> 0 then
- Exit;
- if UpperCase(Prot) = 'HTTPS' then
- FSock.SSLDoConnect;
- if FSock.LastError <> 0 then
- Exit;
- FAliveHost := FTargetHost;
- FAlivePort := FTargetPort;
- end
- else
- begin
- if FSock.CanRead(0) then
- begin
- FSock.CloseSocket;
- FSock.Bind(FIPInterface, cAnyPort);
- if FSock.LastError <> 0 then
- Exit;
- if FSock.LastError <> 0 then
- Exit;
- FSock.Connect(FTargetHost, FTargetPort);
- if FSock.LastError = 0 then
- if UpperCase(Prot) = 'HTTPS' then
- FSock.SSLDoConnect;
- if FSock.LastError <> 0 then
- begin
- FSock.CloseSocket;
- FAliveHost := '';
- FAlivePort := '';
- Exit;
- end;
- end;
+ FAliveHost := '';
+ FAlivePort := '';
+ Exit;
end;
- { send Headers }
- if FProtocol = '0.9' then
- FSock.SendString(FHeaders[0] + CRLF)
- else
-{$IFDEF LINUX}
- FSock.SendString(AdjustLineBreaks(FHeaders.Text, tlbsCRLF));
-{$ELSE}
- FSock.SendString(FHeaders.Text);
-{$ENDIF}
- if FSock.LastError <> 0 then
- Exit;
-
{ reading Status }
+ FDocument.Position := 0;
Status100Error := '';
if status100 then
begin
+ { send Headers }
+ FSock.SendString(PrepareHeaders);
+ if FSock.LastError <> 0 then
+ Exit;
repeat
s := FSock.RecvString(FTimeout);
if s <> '' then
Break;
until FSock.LastError <> 0;
DecodeStatus(s);
+ Status100Error := s;
+ repeat
+ s := FSock.recvstring(FTimeout);
+ if s = '' then
+ Break;
+ until FSock.LastError <> 0;
if (FResultCode >= 100) and (FResultCode < 200) then
- repeat
- s := FSock.recvstring(FTimeout);
- if s = '' then
- Break;
- until FSock.LastError <> 0
+ begin
+ { we can upload content }
+ Status100Error := '';
+ FUploadSize := FDocument.Size;
+ FSock.SendBuffer(FDocument.Memory, FDocument.Size);
+ end;
+ end
+ else
+ { upload content }
+ if sending then
+ begin
+ if FDocument.Size >= c64k then
+ begin
+ FSock.SendString(PrepareHeaders);
+ FUploadSize := FDocument.Size;
+ FSock.SendBuffer(FDocument.Memory, FDocument.Size);
+ end
+ else
+ begin
+ s := PrepareHeaders + ReadStrFromStream(FDocument, FDocument.Size);
+ FUploadSize := Length(s);
+ FSock.SendString(s);
+ end;
+ end
else
begin
- Sending := False;
- Status100Error := s;
+ { we not need to upload document, send headers only }
+ FSock.SendString(PrepareHeaders);
end;
- end;
- { send document }
- if Sending then
- begin
- FUploadSize := FDocument.Size;
- FSock.SendBuffer(FDocument.Memory, FDocument.Size);
- if FSock.LastError <> 0 then
- Exit;
- end;
+ if FSock.LastError <> 0 then
+ Exit;
Clear;
Size := -1;
@@ -556,6 +581,8 @@ begin
ToClose := True;
until FSock.LastError <> 0;
Result := FSock.LastError = 0;
+ if not Result then
+ Exit;
{if need receive response body, read it}
Receiving := Method <> 'HEAD';
@@ -590,7 +617,7 @@ begin
if FSock.LastError = 0 then
WriteStrToStream(FDocument, s);
until FSock.LastError <> 0;
- Result := True;
+ Result := FSock.LastError = WSAECONNRESET;
end;
function THTTPSend.ReadIdentity(Size: Integer): Boolean;
diff --git a/ldapsend.pas b/ldapsend.pas
index efac6b6..2b6532d 100644
--- a/ldapsend.pas
+++ b/ldapsend.pas
@@ -1,5 +1,5 @@
{==============================================================================|
-| Project : Ararat Synapse | 001.004.000 |
+| Project : Ararat Synapse | 001.004.001 |
|==============================================================================|
| Content: LDAP client |
|==============================================================================|
@@ -344,7 +344,9 @@ var
begin
s := Value;
if FIsbinary then
- s := EncodeBase64(Value);
+ s := EncodeBase64(Value)
+ else
+ s :=UnquoteStr(s, '"');
inherited Put(Index, s);
end;
@@ -1091,7 +1093,7 @@ begin
while n < i do
begin
u := ASNItem(n, t, x);
- a.Add(UnquoteStr(u, '"'));
+ a.Add(u);
end;
end;
end;
diff --git a/mimepart.pas b/mimepart.pas
index f3e91a3..9aad90e 100644
--- a/mimepart.pas
+++ b/mimepart.pas
@@ -1,5 +1,5 @@
{==============================================================================|
-| Project : Ararat Synapse | 002.007.002 |
+| Project : Ararat Synapse | 002.007.005 |
|==============================================================================|
| Content: MIME support procedures and functions |
|==============================================================================|
@@ -61,13 +61,7 @@ interface
uses
SysUtils, Classes,
-{$IFDEF LINUX}
- {$IFDEF FPC}
synafpc,
- {$ENDIF}
-{$ELSE}
- Windows,
-{$ENDIF}
synachar, synacode, synautil, mimeinln;
type
@@ -542,6 +536,7 @@ begin
Result.DefaultCharset := FDefaultCharset;
FSubParts.Add(Result);
Result.SubLevel := FSubLevel + 1;
+ Result.MaxSubLevel := FMaxSubLevel;
end;
{==============================================================================}
@@ -762,12 +757,16 @@ begin
if FConvertCharset and (FPrimaryCode = MP_TEXT) then
if (not FForcedHTMLConvert) and (uppercase(FSecondary) = 'HTML') then
begin
+ b := false;
t := uppercase(s);
t := SeparateLeft(t, '</HEAD>');
- t := SeparateRight(t, '<HEAD>');
- t := ReplaceString(t, '"', '');
- t := ReplaceString(t, ' ', '');
- b := Pos('HTTP-EQUIV=CONTENT-TYPE', t) > 0;
+ if length(t) <> length(s) then
+ begin
+ t := SeparateRight(t, '<HEAD>');
+ t := ReplaceString(t, '"', '');
+ t := ReplaceString(t, ' ', '');
+ b := Pos('HTTP-EQUIV=CONTENT-TYPE', t) > 0;
+ end;
if not b then
s := CharsetConversion(s, FCharsetCode, FTargetCharset);
end
diff --git a/pingsend.pas b/pingsend.pas
index 2ab07c3..5e88fc8 100644
--- a/pingsend.pas
+++ b/pingsend.pas
@@ -1,5 +1,5 @@
{==============================================================================|
-| Project : Ararat Synapse | 003.001.006 |
+| Project : Ararat Synapse | 003.001.008 |
|==============================================================================|
| Content: PING sender |
|==============================================================================|
@@ -59,16 +59,15 @@ Note: IPv6 not working under .NET. It is lack of Microsoft's .NET framework.
{$R-}
{$H+}
+{$IFDEF CIL}
+ Sorry, this unit is not for .NET!
+{$ENDIF}
+
unit pingsend;
interface
uses
-{$IFDEF LINUX}
- Libc,
-{$ELSE}
- Windows,
-{$ENDIF}
SysUtils,
synsock, blcksock, synautil;
@@ -91,7 +90,7 @@ type
i_checkSum: Word;
i_Id: Word;
i_seq: Word;
- TimeStamp: ULong;
+ TimeStamp: integer;
end;
{:record used internally by TPingSend for compute checksum of ICMPv6 packet
@@ -274,7 +273,7 @@ begin
break;
if fSock.IP6used then
begin
-{$IFDEF LINUX}
+{$IFNDEF WIN32}
IcmpEchoHeaderPtr := Pointer(FBuffer);
{$ELSE}
//WinXP SP1 with networking update doing this think by another way ;-O
@@ -289,6 +288,12 @@ begin
IpHdrLen := (IPHeadPtr^.VerLen and $0F) * 4;
IcmpEchoHeaderPtr := @FBuffer[IpHdrLen + 1];
end;
+ //check for timeout
+ if TickDelta(x, GetTick) > FTimeout then
+ begin
+ t := false;
+ Break;
+ end;
//it discard sometimes possible 'echoes' of previosly sended packet
//or other unwanted ICMP packets...
until (IcmpEchoHeaderPtr^.i_type <> FIcmpEcho)
@@ -307,7 +312,7 @@ end;
function TPINGSend.Checksum(Value: string): Word;
var
- CkSum: DWORD;
+ CkSum: integer;
Num, Remain: Integer;
n, i: Integer;
begin
@@ -341,9 +346,8 @@ var
ip6: TSockAddrIn6;
x: integer;
begin
-{$IFDEF LINUX}
Result := 0;
-{$ELSE}
+{$IFDEF WIN32}
s := StringOfChar(#0, SizeOf(TICMP6Packet)) + Value;
ICMP6Ptr := Pointer(s);
x := synsock.WSAIoctl(FSock.Socket, SIO_ROUTING_INTERFACE_QUERY,
diff --git a/pop3send.pas b/pop3send.pas
index 33d35b9..790b921 100644
--- a/pop3send.pas
+++ b/pop3send.pas
@@ -1,5 +1,5 @@
{==============================================================================|
-| Project : Ararat Synapse | 002.004.000 |
+| Project : Ararat Synapse | 002.005.000 |
|==============================================================================|
| Content: POP3 client |
|==============================================================================|
@@ -84,6 +84,7 @@ type
FFullResult: TStringList;
FStatCount: Integer;
FStatSize: Integer;
+ FListSize: Integer;
FTimeStamp: string;
FAuthType: TPOP3AuthType;
FPOP3cap: TStringList;
@@ -125,6 +126,10 @@ type
@link(FullResult). If all OK, result is @true.}
function Retr(Value: Integer): Boolean;
+ {:Send RETR command. After successful operation dowloaded message in
+ @link(Stream). If all OK, result is @true.}
+ function RetrStream(Value: Integer; Stream: TStream): Boolean;
+
{:Send DELE command for delete specified message. If all OK, result is @true.}
function Dele(Value: Integer): Boolean;
@@ -161,6 +166,9 @@ type
{:After STAT command is there size of all messages in inbox.}
property StatSize: Integer read FStatSize;
+ {:After LIST 0 command size of all messages on server, After LIST x size of message x on server}
+ property ListSize: Integer read FListSize;
+
{:If server support this, after comnnect is in this property timestamp of
remote server.}
property TimeStamp: string read FTimeStamp;
@@ -195,6 +203,7 @@ begin
FTargetPort := cPop3Protocol;
FStatCount := 0;
FStatSize := 0;
+ FListSize := 0;
FAuthType := POP3AuthAll;
FAutoTLS := False;
FFullSSL := False;
@@ -351,12 +360,25 @@ begin
end;
function TPOP3Send.List(Value: Integer): Boolean;
+var
+ s: string;
+ n: integer;
begin
if Value = 0 then
FSock.SendString('LIST' + CRLF)
else
FSock.SendString('LIST ' + IntToStr(Value) + CRLF);
Result := ReadResult(Value = 0) = 1;
+ FListSize := 0;
+ if Result then
+ if Value <> 0 then
+ begin
+ s := SeparateRight(ResultString, '+OK ');
+ FListSize := StrToIntDef(SeparateLeft(SeparateRight(s, ' '), ' '), 0);
+ end
+ else
+ for n := 0 to FFullResult.Count - 1 do
+ FListSize := FListSize + StrToIntDef(SeparateLeft(SeparateRight(s, ' '), ' '), 0);
end;
function TPOP3Send.Retr(Value: Integer): Boolean;
@@ -365,6 +387,40 @@ begin
Result := ReadResult(True) = 1;
end;
+//based on code by Miha Vrhovnik
+function TPOP3Send.RetrStream(Value: Integer; Stream: TStream): Boolean;
+var
+ s: string;
+begin
+ Result := False;
+ FFullResult.Clear;
+ Stream.Size := 0;
+ FSock.SendString('RETR ' + IntToStr(Value) + CRLF);
+
+ s := FSock.RecvString(FTimeout);
+ if Pos('+OK', s) = 1 then
+ Result := True;
+ FResultString := s;
+ if Result then begin
+ repeat
+ s := FSock.RecvString(FTimeout);
+ if s = '.' then
+ Break;
+ if s <> '' then begin
+ if s[1] = '.' then
+ Delete(s, 1, 1);
+ end;
+ WriteStrToStream(Stream, s);
+ WriteStrToStream(Stream, CRLF);
+ until FSock.LastError <> 0;
+ end;
+
+ if Result then
+ FResultCode := 1
+ else
+ FResultCode := 0;
+end;
+
function TPOP3Send.Dele(Value: Integer): Boolean;
begin
FSock.SendString('DELE ' + IntToStr(Value) + CRLF);
diff --git a/snmpsend.pas b/snmpsend.pas
index fc39c9b..e5c2939 100644
--- a/snmpsend.pas
+++ b/snmpsend.pas
@@ -62,7 +62,7 @@ interface
uses
Classes, SysUtils,
- blcksock, synautil, asn1util, synacode;
+ blcksock, synautil, asn1util, synaip, synacode;
const
cSnmpProtocol = '161';
diff --git a/ssdotnet.pas b/ssdotnet.pas
index 799ea28..8a54cd8 100644
--- a/ssdotnet.pas
+++ b/ssdotnet.pas
@@ -49,7 +49,7 @@
interface
uses
- SyncObjs, SysUtils,
+ SyncObjs, SysUtils, Classes,
System.Net,
System.Net.Sockets;
@@ -73,6 +73,7 @@ type
TMemory = Array of byte;
TLinger = LingerOption;
TSocket = socket;
+ TAddrFamily = AddressFamily;
const
WSADESCRIPTION_LEN = 256;
@@ -89,33 +90,10 @@ type
// lpVendorInfo: PChar;
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;
-
- S6_Bytes = SunB6;
- S6_Addr = SunB6;
-
- TInAddr6 = packed record
- S_un_b: SunB6;
- end;
-
- 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;
-
-
const
MSG_NOSIGNAL = 0;
INVALID_SOCKET = nil;
+ AF_UNSPEC = AddressFamily.Unspecified;
AF_INET = AddressFamily.InterNetwork;
AF_INET6 = AddressFamily.InterNetworkV6;
SOCKET_ERROR = integer(-1);
@@ -387,7 +365,7 @@ function RecvFrom(s: TSocket; Buf: TMemory; len, flags: Integer; var from: TVarS
function ntohs(netshort: u_short): u_short;
function ntohl(netlong: u_long): u_long;
function Listen(s: TSocket; backlog: Integer): Integer;
- function IoctlSocket(s: TSocket; cmd: DWORD; var arg: u_long): Integer;
+ function IoctlSocket(s: TSocket; cmd: DWORD; var arg: integer): Integer;
function htons(hostshort: u_short): u_short;
function htonl(hostlong: u_long): u_long;
// function GetSockName(s: TSocket; name: PSockAddr; var namelen: Integer): Integer;
@@ -414,6 +392,14 @@ function RecvFrom(s: TSocket; Buf: TMemory; len, flags: Integer; var from: TVarS
function GetPortService(value: string): integer;
+function IsNewApi(Family: TAddrFamily): Boolean;
+function SetVarSin(var Sin: TVarSin; IP, Port: string; Family: TAddrFamily; SockProtocol, SockType: integer; PreferIP4: Boolean): integer;
+function GetSinIP(Sin: TVarSin): string;
+function GetSinPort(Sin: TVarSin): Integer;
+procedure ResolveNameToIP(Name: string; Family: TAddrFamily; SockProtocol, SockType: integer; const IPList: TStrings);
+function ResolveIPToName(IP: string; Family: TAddrFamily; SockProtocol, SockType: integer): string;
+function ResolvePort(Port: string; Family: TAddrFamily; SockProtocol, SockType: integer): Word;
+
var
SynSockCS: SyncObjs.TCriticalSection;
SockEnhancedApi: Boolean;
@@ -826,7 +812,7 @@ begin
end;
end;
-function IoctlSocket(s: TSocket; cmd: DWORD; var arg: u_long): Integer;
+function IoctlSocket(s: TSocket; cmd: DWORD; var arg: integer): Integer;
var
inv, outv: TMemory;
begin
@@ -840,7 +826,7 @@ begin
inv := BitConverter.GetBytes(arg);
outv := BitConverter.GetBytes(integer(0));
s.IOControl(cmd, inv, outv);
- arg := BitConverter.ToUInt32(outv, 0);
+ arg := BitConverter.ToInt32(outv, 0);
end;
except
on e: System.Net.Sockets.SocketException do
@@ -985,6 +971,106 @@ begin
Result := StrToIntDef(value, 0);
end;
+{=============================================================================}
+function IsNewApi(Family: TAddrFamily): Boolean;
+begin
+ Result := true;
+end;
+
+function SetVarSin(var Sin: TVarSin; IP, Port: string; Family: TAddrFamily; SockProtocol, SockType: integer; PreferIP4: Boolean): integer;
+var
+ IPs: array of IPAddress;
+ n: integer;
+ ip4, ip6: string;
+ sip: string;
+begin
+ sip := '';
+ ip4 := '';
+ ip6 := '';
+ IPs := Dns.Resolve(IP).AddressList;
+ for n :=low(IPs) to high(IPs) do begin
+ if (ip4 = '') and (IPs[n].AddressFamily = AF_INET) then
+ ip4 := IPs[n].toString;
+ if (ip6 = '') and (IPs[n].AddressFamily = AF_INET6) then
+ ip6 := IPs[n].toString;
+ if (ip4 <> '') and (ip6 <> '') then
+ break;
+ end;
+ case Family of
+ AF_UNSPEC:
+ begin
+ if (ip4 <> '') and (ip6 <> '') then
+ begin
+ if PreferIP4 then
+ sip := ip4
+ else
+ Sip := ip6;
+ end
+ else
+ begin
+ sip := ip4;
+ if (ip6 <> '') then
+ sip := ip6;
+ end;
+ end;
+ AF_INET:
+ sip := ip4;
+ AF_INET6:
+ sip := ip6;
+ end;
+ sin := TVarSin.Create(IPAddress.Parse(sip), GetPortService(Port));
+end;
+
+function GetSinIP(Sin: TVarSin): string;
+begin
+ Result := Sin.Address.ToString;
+end;
+
+function GetSinPort(Sin: TVarSin): Integer;
+begin
+ Result := Sin.Port;
+end;
+
+procedure ResolveNameToIP(Name: string; Family: TAddrFamily; SockProtocol, SockType: integer; const IPList: TStrings);
+var
+ IPs :array of IPAddress;
+ n: integer;
+begin
+ IPList.Clear;
+ IPs := Dns.Resolve(Name).AddressList;
+ for n := low(IPs) to high(IPs) do
+ begin
+ if not(((Family = AF_INET6) and (IPs[n].AddressFamily = AF_INET))
+ or ((Family = AF_INET) and (IPs[n].AddressFamily = AF_INET6))) then
+ begin
+ IPList.Add(IPs[n].toString);
+ end;
+ end;
+end;
+
+function ResolvePort(Port: string; Family: TAddrFamily; SockProtocol, SockType: integer): Word;
+var
+ n: integer;
+begin
+ Result := StrToIntDef(port, 0);
+ if Result = 0 then
+ begin
+ port := Lowercase(port);
+ for n := 0 to High(Services) do
+ if services[n, 0] = port then
+ begin
+ Result := strtointdef(services[n, 1], 0);
+ break;
+ end;
+ end;
+end;
+
+function ResolveIPToName(IP: string; Family: TAddrFamily; SockProtocol, SockType: integer): string;
+begin
+ Result := Dns.GetHostByAddress(IP).HostName;
+end;
+
+
{=============================================================================}
function InitSocketInterface(stack: string): Boolean;
begin
diff --git a/ssfpc.pas b/ssfpc.pas
new file mode 100644
index 0000000..6957bbf
--- /dev/null
+++ b/ssfpc.pas
@@ -0,0 +1,868 @@
+{==============================================================================|
+| Project : Ararat Synapse | 001.000.003 |
+|==============================================================================|
+| Content: Socket Independent Platform Layer - FreePascal definition include |
+|==============================================================================|
+| Copyright (c)2006, Lukas Gebauer |
+| All rights reserved. |
+| |
+| Redistribution and use in source and binary forms, with or without |
+| modification, are permitted provided that the following conditions are met: |
+| |
+| Redistributions of source code must retain the above copyright notice, this |
+| list of conditions and the following disclaimer. |
+| |
+| Redistributions in binary form must reproduce the above copyright notice, |
+| this list of conditions and the following disclaimer in the documentation |
+| and/or other materials provided with the distribution. |
+| |
+| Neither the name of Lukas Gebauer nor the names of its contributors may |
+| be used to endorse or promote products derived from this software without |
+| specific prior written permission. |
+| |
+| THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" |
+| AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE |
+| IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE |
+| ARE DISCLAIMED. IN NO EVENT SHALL THE REGENTS OR CONTRIBUTORS BE LIABLE FOR |
+| ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL |
+| DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR |
+| SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER |
+| CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT |
+| LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY |
+| OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH |
+| DAMAGE. |
+|==============================================================================|
+| The Initial Developer of the Original Code is Lukas Gebauer (Czech Republic).|
+| Portions created by Lukas Gebauer are Copyright (c)2006. |
+| All Rights Reserved. |
+|==============================================================================|
+| Contributor(s): |
+|==============================================================================|
+| History: see HISTORY.HTM from distribution package |
+| (Found at URL: http://www.ararat.cz/synapse/) |
+|==============================================================================}
+
+{:@exclude}
+
+{$IFDEF FPC}
+
+//{$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 the new API
+is used, when running system allows it.
+
+For IPv6 support you must have new API!
+}
+
+{$IFDEF FPC}
+ {$MODE DELPHI}
+{$ENDIF}
+{$H+}
+
+{$ifdef FreeBSD}
+{$DEFINE SOCK_HAS_SINLEN} // BSD definition of scoketaddr
+{$endif}
+{$ifdef darwin}
+{$DEFINE SOCK_HAS_SINLEN} // BSD definition of scoketaddr
+{$endif}
+
+interface
+
+uses
+ SyncObjs, SysUtils, Classes,
+ synafpc, BaseUnix, Unix, termio, sockets, netdb;
+
+function InitSocketInterface(stack: string): Boolean;
+function DestroySocketInterface: Boolean;
+
+const
+ DLLStackName = '';
+ WinsockLevel = $0202;
+
+ cLocalHost = '127.0.0.1';
+ cAnyHost = '0.0.0.0';
+ c6AnyHost = '::0';
+
+type
+ TSocket = longint;
+ TAddrFamily = integer;
+
+ TMemory = pointer;
+
+
+type
+ TFDSet = Baseunix.TFDSet;
+ PFDSet = ^TFDSet;
+ Ptimeval = Baseunix.ptimeval;
+ Ttimeval = Baseunix.ttimeval;
+
+const
+ FIONREAD = termio.FIONREAD;
+ FIONBIO = termio.FIONBIO;
+ FIOASYNC = termio.FIOASYNC;
+
+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
+ PInAddr = ^TInAddr;
+ TInAddr = sockets.in_addr;
+
+ PSockAddrIn = ^TSockAddrIn;
+ TSockAddrIn = sockets.TInetSockAddr;
+
+
+ TIP_mreq = record
+ imr_multiaddr: TInAddr; // IP multicast address of group
+ imr_interface: TInAddr; // local IP address of interface
+ end;
+
+
+ PInAddr6 = ^TInAddr6;
+ TInAddr6 = sockets.Tin6_addr;
+
+ PSockAddrIn6 = ^TSockAddrIn6;
+ TSockAddrIn6 = sockets.TInetSockAddr6;
+
+
+ TIPv6_mreq = record
+ ipv6mr_multiaddr: TInAddr6; // IPv6 multicast address.
+ ipv6mr_interface: integer; // Interface index.
+ end;
+
+const
+ INADDR_ANY = $00000000;
+ INADDR_LOOPBACK = $7F000001;
+ INADDR_BROADCAST = $FFFFFFFF;
+ INADDR_NONE = $FFFFFFFF;
+ ADDR_ANY = INADDR_ANY;
+ INVALID_SOCKET = TSocket(NOT(0));
+ SOCKET_ERROR = -1;
+
+Const
+ IP_TOS = sockets.IP_TOS; { int; IP type of service and precedence. }
+ IP_TTL = sockets.IP_TTL; { int; IP time to live. }
+ IP_HDRINCL = sockets.IP_HDRINCL; { int; Header is included with data. }
+ IP_OPTIONS = sockets.IP_OPTIONS; { ip_opts; IP per-packet options. }
+// IP_ROUTER_ALERT = sockets.IP_ROUTER_ALERT; { bool }
+ IP_RECVOPTS = sockets.IP_RECVOPTS; { bool }
+ IP_RETOPTS = sockets.IP_RETOPTS; { bool }
+// IP_PKTINFO = sockets.IP_PKTINFO; { bool }
+// IP_PKTOPTIONS = sockets.IP_PKTOPTIONS;
+// IP_PMTUDISC = sockets.IP_PMTUDISC; { obsolete name? }
+// IP_MTU_DISCOVER = sockets.IP_MTU_DISCOVER; { int; see below }
+// IP_RECVERR = sockets.IP_RECVERR; { bool }
+// IP_RECVTTL = sockets.IP_RECVTTL; { bool }
+// IP_RECVTOS = sockets.IP_RECVTOS; { bool }
+ IP_MULTICAST_IF = sockets.IP_MULTICAST_IF; { in_addr; set/get IP multicast i/f }
+ IP_MULTICAST_TTL = sockets.IP_MULTICAST_TTL; { u_char; set/get IP multicast ttl }
+ IP_MULTICAST_LOOP = sockets.IP_MULTICAST_LOOP; { i_char; set/get IP multicast loopback }
+ IP_ADD_MEMBERSHIP = sockets.IP_ADD_MEMBERSHIP; { ip_mreq; add an IP group membership }
+ IP_DROP_MEMBERSHIP = sockets.IP_DROP_MEMBERSHIP; { ip_mreq; drop an IP group membership }
+
+ SOL_SOCKET = sockets.SOL_SOCKET;
+
+ SO_DEBUG = sockets.SO_DEBUG;
+ SO_REUSEADDR = sockets.SO_REUSEADDR;
+ SO_TYPE = sockets.SO_TYPE;
+ SO_ERROR = sockets.SO_ERROR;
+ SO_DONTROUTE = sockets.SO_DONTROUTE;
+ SO_BROADCAST = sockets.SO_BROADCAST;
+ SO_SNDBUF = sockets.SO_SNDBUF;
+ SO_RCVBUF = sockets.SO_RCVBUF;
+ SO_KEEPALIVE = sockets.SO_KEEPALIVE;
+ SO_OOBINLINE = sockets.SO_OOBINLINE;
+// SO_NO_CHECK = sockets.SO_NO_CHECK;
+// SO_PRIORITY = sockets.SO_PRIORITY;
+ SO_LINGER = sockets.SO_LINGER;
+// SO_BSDCOMPAT = sockets.SO_BSDCOMPAT;
+// SO_REUSEPORT = sockets.SO_REUSEPORT;
+// SO_PASSCRED = sockets.SO_PASSCRED;
+// SO_PEERCRED = sockets.SO_PEERCRED;
+ SO_RCVLOWAT = sockets.SO_RCVLOWAT;
+ SO_SNDLOWAT = sockets.SO_SNDLOWAT;
+ SO_RCVTIMEO = sockets.SO_RCVTIMEO;
+ SO_SNDTIMEO = sockets.SO_SNDTIMEO;
+{ Security levels - as per NRL IPv6 - don't actually do anything }
+// SO_SECURITY_AUTHENTICATION = sockets.SO_SECURITY_AUTHENTICATION;
+// SO_SECURITY_ENCRYPTION_TRANSPORT = sockets.SO_SECURITY_ENCRYPTION_TRANSPORT;
+// SO_SECURITY_ENCRYPTION_NETWORK = sockets.SO_SECURITY_ENCRYPTION_NETWORK;
+// SO_BINDTODEVICE = sockets.SO_BINDTODEVICE;
+{ Socket filtering }
+// SO_ATTACH_FILTER = sockets.SO_ATTACH_FILTER;
+// SO_DETACH_FILTER = sockets.SO_DETACH_FILTER;
+
+ SOMAXCONN = 1024;
+
+ IPV6_UNICAST_HOPS = sockets.IPV6_UNICAST_HOPS;
+ IPV6_MULTICAST_IF = sockets.IPV6_MULTICAST_IF;
+ IPV6_MULTICAST_HOPS = sockets.IPV6_MULTICAST_HOPS;
+ IPV6_MULTICAST_LOOP = sockets.IPV6_MULTICAST_LOOP;
+ IPV6_JOIN_GROUP = sockets.IPV6_JOIN_GROUP;
+ IPV6_LEAVE_GROUP = sockets.IPV6_LEAVE_GROUP;
+
+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. }
+ AF_INET6 = 10; { Internetwork Version 6 }
+ 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 for manipulating linger option. }
+ PLinger = ^TLinger;
+ TLinger = packed record
+ l_onoff: integer;
+ l_linger: integer;
+ end;
+
+const
+
+ MSG_OOB = sockets.MSG_OOB; // Process out-of-band data.
+ MSG_PEEK = sockets.MSG_PEEK; // Peek at incoming messages.
+ MSG_NOSIGNAL = sockets.MSG_NOSIGNAL; // Do not generate SIGPIPE.
+
+const
+ WSAEINTR = ESysEINTR;
+ WSAEBADF = ESysEBADF;
+ WSAEACCES = ESysEACCES;
+ WSAEFAULT = ESysEFAULT;
+ WSAEINVAL = ESysEINVAL;
+ WSAEMFILE = ESysEMFILE;
+ WSAEWOULDBLOCK = ESysEWOULDBLOCK;
+ WSAEINPROGRESS = ESysEINPROGRESS;
+ WSAEALREADY = ESysEALREADY;
+ WSAENOTSOCK = ESysENOTSOCK;
+ WSAEDESTADDRREQ = ESysEDESTADDRREQ;
+ WSAEMSGSIZE = ESysEMSGSIZE;
+ WSAEPROTOTYPE = ESysEPROTOTYPE;
+ WSAENOPROTOOPT = ESysENOPROTOOPT;
+ WSAEPROTONOSUPPORT = ESysEPROTONOSUPPORT;
+ WSAESOCKTNOSUPPORT = ESysESOCKTNOSUPPORT;
+ WSAEOPNOTSUPP = ESysEOPNOTSUPP;
+ WSAEPFNOSUPPORT = ESysEPFNOSUPPORT;
+ WSAEAFNOSUPPORT = ESysEAFNOSUPPORT;
+ WSAEADDRINUSE = ESysEADDRINUSE;
+ WSAEADDRNOTAVAIL = ESysEADDRNOTAVAIL;
+ WSAENETDOWN = ESysENETDOWN;
+ WSAENETUNREACH = ESysENETUNREACH;
+ WSAENETRESET = ESysENETRESET;
+ WSAECONNABORTED = ESysECONNABORTED;
+ WSAECONNRESET = ESysECONNRESET;
+ WSAENOBUFS = ESysENOBUFS;
+ WSAEISCONN = ESysEISCONN;
+ WSAENOTCONN = ESysENOTCONN;
+ WSAESHUTDOWN = ESysESHUTDOWN;
+ WSAETOOMANYREFS = ESysETOOMANYREFS;
+ WSAETIMEDOUT = ESysETIMEDOUT;
+ WSAECONNREFUSED = ESysECONNREFUSED;
+ WSAELOOP = ESysELOOP;
+ WSAENAMETOOLONG = ESysENAMETOOLONG;
+ WSAEHOSTDOWN = ESysEHOSTDOWN;
+ WSAEHOSTUNREACH = ESysEHOSTUNREACH;
+ WSAENOTEMPTY = ESysENOTEMPTY;
+ WSAEPROCLIM = -1;
+ WSAEUSERS = ESysEUSERS;
+ WSAEDQUOT = ESysEDQUOT;
+ WSAESTALE = ESysESTALE;
+ WSAEREMOTE = ESysEREMOTE;
+ WSASYSNOTREADY = -2;
+ WSAVERNOTSUPPORTED = -3;
+ WSANOTINITIALISED = -4;
+ WSAEDISCON = -5;
+ WSAHOST_NOT_FOUND = 1;
+ WSATRY_AGAIN = 2;
+ WSANO_RECOVERY = 3;
+ WSANO_DATA = -6;
+
+const
+ WSADESCRIPTION_LEN = 256;
+ WSASYS_STATUS_LEN = 128;
+type
+ PWSAData = ^TWSAData;
+ TWSAData = packed record
+ wVersion: Word;
+ wHighVersion: Word;
+ szDescription: array[0..WSADESCRIPTION_LEN] of Char;
+ szSystemStatus: array[0..WSASYS_STATUS_LEN] of Char;
+ iMaxSockets: Word;
+ iMaxUdpDg: Word;
+ lpVendorInfo: PChar;
+ end;
+
+ function IN6_IS_ADDR_UNSPECIFIED(const a: PInAddr6): boolean;
+ function IN6_IS_ADDR_LOOPBACK(const a: PInAddr6): boolean;
+ function IN6_IS_ADDR_LINKLOCAL(const a: PInAddr6): boolean;
+ function IN6_IS_ADDR_SITELOCAL(const a: PInAddr6): boolean;
+ function IN6_IS_ADDR_MULTICAST(const a: PInAddr6): boolean;
+ function IN6_ADDR_EQUAL(const a: PInAddr6; const b: PInAddr6):boolean;
+ procedure SET_IN6_IF_ADDR_ANY (const a: PInAddr6);
+ procedure SET_LOOPBACK_ADDR6 (const a: PInAddr6);
+
+var
+ in6addr_any, in6addr_loopback : TInAddr6;
+
+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);
+
+{=============================================================================}
+
+var
+ SynSockCS: SyncObjs.TCriticalSection;
+ SockEnhancedApi: Boolean;
+ SockWship6Api: Boolean;
+
+type
+ TVarSin = packed record
+ {$ifdef SOCK_HAS_SINLEN}
+ sin_len : cuchar;
+ {$endif}
+ case integer of
+ 0: (AddressFamily: sa_family_t);
+ 1: (
+ case sin_family: sa_family_t of
+ AF_INET: (sin_port: word;
+ sin_addr: TInAddr;
+ sin_zero: array[0..7] of Char);
+ AF_INET6: (sin6_port: word;
+ sin6_flowinfo: longword;
+ sin6_addr: TInAddr6;
+ sin6_scope_id: longword);
+ );
+ end;
+
+function SizeOfVarSin(sin: TVarSin): integer;
+
+ function WSAStartup(wVersionRequired: Word; var WSData: TWSAData): Integer;
+ function WSACleanup: Integer;
+ function WSAGetLastError: Integer;
+ function GetHostName: string;
+ function Shutdown(s: TSocket; how: Integer): Integer;
+ function SetSockOpt(s: TSocket; level, optname: Integer; optval: TMemory;
+ optlen: Integer): Integer;
+ function GetSockOpt(s: TSocket; level, optname: Integer; optval: TMemory;
+ var optlen: Integer): Integer;
+ function Send(s: TSocket; Buf: TMemory; len, flags: Integer): Integer;
+ function Recv(s: TSocket; Buf: TMemory; len, flags: Integer): Integer;
+ function SendTo(s: TSocket; Buf: TMemory; len, flags: Integer; addrto: TVarSin): Integer;
+ function RecvFrom(s: TSocket; Buf: TMemory; len, flags: Integer; var from: TVarSin): Integer;
+ function ntohs(netshort: word): word;
+ function ntohl(netlong: longword): longword;
+ function Listen(s: TSocket; backlog: Integer): Integer;
+ function IoctlSocket(s: TSocket; cmd: DWORD; var arg: integer): Integer;
+ function htons(hostshort: word): word;
+ function htonl(hostlong: longword): longword;
+ function GetSockName(s: TSocket; var name: TVarSin): Integer;
+ function GetPeerName(s: TSocket; var name: TVarSin): Integer;
+ function Connect(s: TSocket; const name: TVarSin): Integer;
+ function CloseSocket(s: TSocket): Integer;
+ function Bind(s: TSocket; const addr: TVarSin): Integer;
+ function Accept(s: TSocket; var addr: TVarSin): TSocket;
+ function Socket(af, Struc, Protocol: Integer): TSocket;
+ function Select(nfds: Integer; readfds, writefds, exceptfds: PFDSet;
+ timeout: PTimeVal): Longint;
+
+function IsNewApi(Family: integer): Boolean;
+function SetVarSin(var Sin: TVarSin; IP, Port: string; Family, SockProtocol, SockType: integer; PreferIP4: Boolean): integer;
+function GetSinIP(Sin: TVarSin): string;
+function GetSinPort(Sin: TVarSin): Integer;
+procedure ResolveNameToIP(Name: string; Family, SockProtocol, SockType: integer; const IPList: TStrings);
+function ResolveIPToName(IP: string; Family, SockProtocol, SockType: integer): string;
+function ResolvePort(Port: string; Family, SockProtocol, SockType: integer): Word;
+
+
+{==============================================================================}
+implementation
+
+
+function IN6_IS_ADDR_UNSPECIFIED(const a: PInAddr6): boolean;
+begin
+ Result := ((a^.u6_addr32[0] = 0) and (a^.u6_addr32[1] = 0) and
+ (a^.u6_addr32[2] = 0) and (a^.u6_addr32[3] = 0));
+end;
+
+function IN6_IS_ADDR_LOOPBACK(const a: PInAddr6): boolean;
+begin
+ Result := ((a^.u6_addr32[0] = 0) and (a^.u6_addr32[1] = 0) and
+ (a^.u6_addr32[2] = 0) and
+ (a^.u6_addr8[12] = 0) and (a^.u6_addr8[13] = 0) and
+ (a^.u6_addr8[14] = 0) and (a^.u6_addr8[15] = 1));
+end;
+
+function IN6_IS_ADDR_LINKLOCAL(const a: PInAddr6): boolean;
+begin
+ Result := ((a^.u6_addr8[0] = $FE) and (a^.u6_addr8[1] = $80));
+end;
+
+function IN6_IS_ADDR_SITELOCAL(const a: PInAddr6): boolean;
+begin
+ Result := ((a^.u6_addr8[0] = $FE) and (a^.u6_addr8[1] = $C0));
+end;
+
+function IN6_IS_ADDR_MULTICAST(const a: PInAddr6): boolean;
+begin
+ Result := (a^.u6_addr8[0] = $FF);
+end;
+
+function IN6_ADDR_EQUAL(const a: PInAddr6; const b: PInAddr6): boolean;
+begin
+ Result := (CompareMem( a, b, sizeof(TInAddr6)));
+end;
+
+procedure SET_IN6_IF_ADDR_ANY (const a: PInAddr6);
+begin
+ FillChar(a^, sizeof(TInAddr6), 0);
+end;
+
+procedure SET_LOOPBACK_ADDR6 (const a: PInAddr6);
+begin
+ FillChar(a^, sizeof(TInAddr6), 0);
+ a^.u6_addr8[15] := 1;
+end;
+
+{=============================================================================}
+
+function WSAStartup(wVersionRequired: Word; var WSData: TWSAData): Integer;
+begin
+ with WSData do
+ begin
+ wVersion := wVersionRequired;
+ wHighVersion := $202;
+ szDescription := 'Synsock - Synapse Platform Independent Socket Layer';
+ szSystemStatus := 'Running on Unix/Linux by FreePascal';
+ iMaxSockets := 32768;
+ iMaxUdpDg := 8192;
+ end;
+ Result := 0;
+end;
+
+function WSACleanup: Integer;
+begin
+ Result := 0;
+end;
+
+function WSAGetLastError: Integer;
+begin
+ Result := fpGetErrno;
+end;
+
+function FD_ISSET(Socket: TSocket; var fdset: TFDSet): Boolean;
+begin
+ Result := fpFD_ISSET(socket, fdset) <> 0;
+end;
+
+procedure FD_SET(Socket: TSocket; var fdset: TFDSet);
+begin
+ fpFD_SET(Socket, fdset);
+end;
+
+procedure FD_CLR(Socket: TSocket; var fdset: TFDSet);
+begin
+ fpFD_CLR(Socket, fdset);
+end;
+
+procedure FD_ZERO(var fdset: TFDSet);
+begin
+ fpFD_ZERO(fdset);
+end;
+
+{=============================================================================}
+
+function SizeOfVarSin(sin: TVarSin): integer;
+begin
+ case sin.sin_family of
+ AF_INET:
+ Result := SizeOf(TSockAddrIn);
+ AF_INET6:
+ Result := SizeOf(TSockAddrIn6);
+ else
+ Result := 0;
+ end;
+end;
+
+{=============================================================================}
+
+function Bind(s: TSocket; const addr: TVarSin): Integer;
+begin
+ if sockets.Bind(s, addr, SizeOfVarSin(addr)) then
+ Result := 0
+ else
+ Result := SOCKET_ERROR;
+end;
+
+function Connect(s: TSocket; const name: TVarSin): Integer;
+begin
+ if sockets.Connect(s, name, SizeOfVarSin(name)) then
+ Result := 0
+ else
+ Result := SOCKET_ERROR;
+end;
+
+function GetSockName(s: TSocket; var name: TVarSin): Integer;
+var
+ len: integer;
+begin
+ len := SizeOf(name);
+ FillChar(name, len, 0);
+ Result := sockets.GetSocketName(s, name, Len);
+end;
+
+function GetPeerName(s: TSocket; var name: TVarSin): Integer;
+var
+ len: integer;
+begin
+ len := SizeOf(name);
+ FillChar(name, len, 0);
+ Result := sockets.GetPeerName(s, name, Len);
+end;
+
+function GetHostName: string;
+begin
+ Result := unix.GetHostName;
+end;
+
+function Send(s: TSocket; Buf: TMemory; len, flags: Integer): Integer;
+begin
+ Result := sockets.Send(s, Buf^, len, flags);
+end;
+
+function Recv(s: TSocket; Buf: TMemory; len, flags: Integer): Integer;
+begin
+ Result := sockets.Recv(s, Buf^, len, flags);
+end;
+
+function SendTo(s: TSocket; Buf: TMemory; len, flags: Integer; addrto: TVarSin): Integer;
+begin
+ Result := sockets.SendTo(s, Buf^, len, flags, addrto, SizeOfVarSin(addrto));
+end;
+
+function RecvFrom(s: TSocket; Buf: TMemory; len, flags: Integer; var from: TVarSin): Integer;
+var
+ x: integer;
+begin
+ x := SizeOf(from);
+ Result := sockets.RecvFrom(s, Buf^, len, flags, from, x);
+end;
+
+function Accept(s: TSocket; var addr: TVarSin): TSocket;
+var
+ x: integer;
+begin
+ x := SizeOf(addr);
+ Result := sockets.Accept(s, addr, x);
+end;
+
+function Shutdown(s: TSocket; how: Integer): Integer;
+begin
+ Result := sockets.Shutdown(s, how);
+end;
+
+function SetSockOpt(s: TSocket; level, optname: Integer; optval: Tmemory;
+ optlen: Integer): Integer;
+begin
+ Result := sockets.SetSocketOptions(s, level, optname, optval^, optlen);
+end;
+
+function GetSockOpt(s: TSocket; level, optname: Integer; optval: Tmemory;
+ var optlen: Integer): Integer;
+begin
+ Result := sockets.GetSocketOptions(s, level, optname, optval^, optlen);
+end;
+
+function ntohs(netshort: word): word;
+begin
+ Result := sockets.ntohs(NetShort);
+end;
+
+function ntohl(netlong: longword): longword;
+begin
+ Result := sockets.ntohl(NetLong);
+end;
+
+function Listen(s: TSocket; backlog: Integer): Integer;
+begin
+ if sockets.Listen(s, backlog) then
+ Result := 0
+ else
+ Result := SOCKET_ERROR;
+end;
+
+function IoctlSocket(s: TSocket; cmd: DWORD; var arg: integer): Integer;
+begin
+ Result := fpIoctl(s, cmd, @arg);
+end;
+
+function htons(hostshort: word): word;
+begin
+ Result := sockets.htons(Hostshort);
+end;
+
+function htonl(hostlong: longword): longword;
+begin
+ Result := sockets.htonl(HostLong);
+end;
+
+function CloseSocket(s: TSocket): Integer;
+begin
+ Result := sockets.CloseSocket(s);
+end;
+
+function Socket(af, Struc, Protocol: Integer): TSocket;
+begin
+ Result := sockets.Socket(af, struc, protocol);
+end;
+
+function Select(nfds: Integer; readfds, writefds, exceptfds: PFDSet;
+ timeout: PTimeVal): Longint;
+begin
+ Result := fpSelect(nfds, readfds, writefds, exceptfds, timeout);
+end;
+
+{=============================================================================}
+function IsNewApi(Family: integer): Boolean;
+begin
+ Result := SockEnhancedApi;
+ if not Result then
+ Result := (Family = AF_INET6) and SockWship6Api;
+end;
+
+function SetVarSin(var Sin: TVarSin; IP, Port: string; Family, SockProtocol, SockType: integer; PreferIP4: Boolean): integer;
+var
+ TwoPass: boolean;
+ f1, f2: integer;
+
+ function GetAddr(f:integer): integer;
+ var
+ a4: array [1..1] of in_addr;
+ a6: array [1..1] of Tin6_addr;
+ begin
+ Result := WSAEPROTONOSUPPORT;
+ case f of
+ AF_INET:
+ begin
+ if IP = cAnyHost then
+ begin
+ Sin.sin_family := AF_INET;
+ Result := 0;
+ end
+ else
+ begin
+ a4[1].s_addr := 0;
+ Result := WSAHOST_NOT_FOUND;
+ a4[1] := StrTonetAddr(IP);
+ if a4[1].s_addr = INADDR_ANY then
+ Resolvename(ip, a4);
+ if a4[1].s_addr <> INADDR_ANY then
+ begin
+ Sin.sin_family := AF_INET;
+ sin.sin_addr := a4[1];
+ Result := 0;
+ end;
+ end;
+ end;
+ AF_INET6:
+ begin
+ if IP = c6AnyHost then
+ begin
+ Sin.sin_family := AF_INET6;
+ Result := 0;
+ end
+ else
+ begin
+ Result := WSAHOST_NOT_FOUND;
+ SET_IN6_IF_ADDR_ANY(@a6[1]);
+ a6[1] := StrTonetAddr6(IP);
+ if IN6_IS_ADDR_UNSPECIFIED(@a6[1]) then
+ Resolvename6(ip, a6);
+ if IN6_IS_ADDR_UNSPECIFIED(@a6[1]) then
+ begin
+ Sin.sin_family := AF_INET6;
+ sin.sin6_addr := a6[1];
+ Result := 0;
+ end;
+ end;
+ end;
+ end;
+ end;
+begin
+ Result := 0;
+ FillChar(Sin, Sizeof(Sin), 0);
+ Sin.sin_port := Resolveport(port, family, SockProtocol, SockType);
+ TwoPass := False;
+ if Family = AF_UNSPEC then
+ begin
+ if PreferIP4 then
+ begin
+ f1 := AF_INET;
+ f2 := AF_INET6;
+ TwoPass := True;
+ end
+ else
+ begin
+ f2 := AF_INET;
+ f1 := AF_INET6;
+ TwoPass := True;
+ end;
+ end
+ else
+ f1 := Family;
+ Result := GetAddr(f1);
+ if Result <> 0 then
+ if TwoPass then
+ Result := GetAddr(f2);
+end;
+
+function GetSinIP(Sin: TVarSin): string;
+begin
+ Result := '';
+ case sin.AddressFamily of
+ AF_INET:
+ begin
+ result := NetAddrToStr(sin.sin_addr);
+ end;
+ AF_INET6:
+ begin
+ result := NetAddrToStr6(sin.sin6_addr);
+ end;
+ end;
+end;
+
+function GetSinPort(Sin: TVarSin): Integer;
+begin
+ if (Sin.sin_family = AF_INET6) then
+ Result := synsock.ntohs(Sin.sin6_port)
+ else
+ Result := synsock.ntohs(Sin.sin_port);
+end;
+
+procedure ResolveNameToIP(Name: string; Family, SockProtocol, SockType: integer; const IPList: TStrings);
+var
+ x, n: integer;
+ a4: array [1..255] of in_addr;
+ a6: array [1..255] of Tin6_addr;
+begin
+ IPList.Clear;
+ if (family = AF_INET) or (family = AF_UNSPEC) then
+ begin
+ a4[1] := StrTonetAddr(name);
+ if a4[1].s_addr = INADDR_ANY then
+ x := Resolvename(name, a4)
+ else
+ x := 1;
+ for n := 1 to x do
+ IpList.Add(netaddrToStr(a4[n]));
+ end;
+
+ if (family = AF_INET6) or (family = AF_UNSPEC) then
+ begin
+ a6[1] := StrTonetAddr6(name);
+ if IN6_IS_ADDR_UNSPECIFIED(@a6[1]) then
+ x := Resolvename6(name, a6)
+ else
+ x := 1;
+ for n := 1 to x do
+ IpList.Add(netaddrToStr6(a6[n]));
+ end;
+
+ if IPList.Count = 0 then
+ IPList.Add(cLocalHost);
+end;
+
+function ResolvePort(Port: string; Family, SockProtocol, SockType: integer): Word;
+var
+ ProtoEnt: TProtocolEntry;
+ ServEnt: TServiceEntry;
+begin
+ Result := synsock.htons(StrToIntDef(Port, 0));
+ if Result = 0 then
+ begin
+ ProtoEnt.Name := '';
+ GetProtocolByNumber(SockProtocol, ProtoEnt);
+ ServEnt.port := 0;
+ GetServiceByName(Port, ProtoEnt.Name, ServEnt);
+ Result := ServEnt.port;
+ end;
+end;
+
+function ResolveIPToName(IP: string; Family, SockProtocol, SockType: integer): string;
+var
+ n: integer;
+ a4: array [1..1] of in_addr;
+ a6: array [1..1] of Tin6_addr;
+ a: array [1..1] of string;
+begin
+ Result := IP;
+ a4[1] := StrToNetAddr(IP);
+ if a4[1].s_addr <> INADDR_ANY then
+ begin
+//why ResolveAddress need address in HOST order? :-O
+ n := ResolveAddress(nettohost(a4[1]), a);
+ if n > 0 then
+ Result := a[1];
+ end
+ else
+ begin
+ a6[1] := StrToNetAddr6(IP);
+ n := ResolveAddress6(a6[1], a);
+ if n > 0 then
+ Result := a[1];
+ end;
+end;
+
+{=============================================================================}
+
+function InitSocketInterface(stack: string): Boolean;
+begin
+ SockEnhancedApi := False;
+ SockWship6Api := False;
+// Libc.Signal(Libc.SIGPIPE, TSignalHandler(Libc.SIG_IGN));
+ Result := True;
+end;
+
+function DestroySocketInterface: Boolean;
+begin
+ Result := True;
+end;
+
+initialization
+begin
+ SynSockCS := SyncObjs.TCriticalSection.Create;
+ SET_IN6_IF_ADDR_ANY (@in6addr_any);
+ SET_LOOPBACK_ADDR6 (@in6addr_loopback);
+end;
+
+finalization
+begin
+ SynSockCS.Free;
+end;
+
+{$ENDIF}
+
diff --git a/ssl_cryptlib.pas b/ssl_cryptlib.pas
index ec76bae..84dd4d8 100644
--- a/ssl_cryptlib.pas
+++ b/ssl_cryptlib.pas
@@ -1,5 +1,5 @@
{==============================================================================|
-| Project : Ararat Synapse | 001.000.002 |
+| Project : Ararat Synapse | 001.001.000 |
|==============================================================================|
| Content: SSL/SSH support by Peter Gutmann's CryptLib |
|==============================================================================|
@@ -97,12 +97,14 @@ type
FCryptSession: CRYPT_SESSION;
FPrivateKeyLabel: string;
FDelCert: Boolean;
+ FReadBuffer: string;
function SSLCheck(Value: integer): Boolean;
function Init(server:Boolean): Boolean;
function DeInit: Boolean;
function Prepare(server:Boolean): Boolean;
function GetString(const cryptHandle: CRYPT_HANDLE; const attributeType: CRYPT_ATTRIBUTE_TYPE): string;
function CreateSelfSignedCert(Host: string): Boolean; override;
+ function PopAll: string;
public
{:See @inherited}
constructor Create(const Value: TTCPBlockSocket); override;
@@ -203,6 +205,8 @@ function TSSLCryptLib.SSLCheck(Value: integer): Boolean;
begin
Result := true;
FLastErrorDesc := '';
+ if Value = CRYPT_ERROR_COMPLETE then
+ Value := 0;
FLastError := Value;
if FLastError <> 0 then
begin
@@ -243,6 +247,28 @@ begin
Result := True;
end;
+function TSSLCryptLib.PopAll: string;
+const
+ BufferMaxSize = 32768;
+var
+ Outbuffer: string;
+ WriteLen: integer;
+begin
+ Result := '';
+ repeat
+ setlength(outbuffer, BufferMaxSize);
+ Writelen := 0;
+ SSLCheck(CryptPopData(FCryptSession, @OutBuffer[1], BufferMaxSize, Writelen));
+ if FLastError <> 0 then
+ Break;
+ if WriteLen > 0 then
+ begin
+ setlength(outbuffer, WriteLen);
+ Result := Result + outbuffer;
+ end;
+ until WriteLen = 0;
+end;
+
function TSSLCryptLib.Init(server:Boolean): Boolean;
var
st: CRYPT_SESSION_TYPE;
@@ -385,6 +411,7 @@ begin
Exit;
FSSLEnabled := True;
Result := True;
+ FReadBuffer := '';
end;
end;
@@ -401,6 +428,7 @@ begin
Exit;
FSSLEnabled := True;
Result := True;
+ FReadBuffer := '';
end;
end;
@@ -414,6 +442,7 @@ begin
if FcryptSession <> CRYPT_SESSION(CRYPT_SESSION_NONE) then
cryptSetAttribute(FCryptSession, CRYPT_SESSINFO_ACTIVE, 0);
DeInit;
+ FReadBuffer := '';
Result := True;
end;
@@ -434,13 +463,18 @@ var
begin
FLastError := 0;
FLastErrorDesc := '';
- SSLCheck(cryptPopData(FCryptSession, Buffer, Len, L));
- Result := l;
+ if Length(FReadBuffer) = 0 then
+ FReadBuffer := PopAll;
+ if Len > Length(FReadBuffer) then
+ Len := Length(FReadBuffer);
+ Move(Pointer(FReadBuffer)^, buffer^, Len);
+ Delete(FReadBuffer, 1, Len);
+ Result := Len;
end;
function TSSLCryptLib.WaitingData: Integer;
begin
- Result := 0;
+ Result := Length(FReadBuffer);
end;
function TSSLCryptLib.GetSSLVersion: string;
diff --git a/ssl_openssl.pas b/ssl_openssl.pas
index 5452705..12c2f1e 100644
--- a/ssl_openssl.pas
+++ b/ssl_openssl.pas
@@ -1,5 +1,5 @@
{==============================================================================|
-| Project : Ararat Synapse | 001.000.003 |
+| Project : Ararat Synapse | 001.000.004 |
|==============================================================================|
| Content: SSL support by OpenSSL |
|==============================================================================|
@@ -643,6 +643,11 @@ begin
Exit;
end;
cert := SSLGetPeerCertificate(Fssl);
+ if not assigned(cert) then
+ begin
+ Result := '';
+ Exit;
+ end;
{$IFDEF CIL}
sb := StringBuilder.Create(4096);
Result := X509NameOneline(X509GetSubjectName(cert), sb, 4096);
@@ -676,6 +681,11 @@ begin
Exit;
end;
cert := SSLGetPeerCertificate(Fssl);
+ if not assigned(cert) then
+ begin
+ Result := '';
+ Exit;
+ end;
{$IFDEF CIL}
sb := StringBuilder.Create(4096);
Result := X509NameOneline(X509GetIssuerName(cert), sb, 4096);
@@ -700,6 +710,11 @@ begin
Exit;
end;
cert := SSLGetPeerCertificate(Fssl);
+ if not assigned(cert) then
+ begin
+ Result := '';
+ Exit;
+ end;
{$IFDEF CIL}
sb := StringBuilder.Create(EVP_MAX_MD_SIZE);
X509Digest(cert, EvpGetDigestByName('MD5'), sb, x);
@@ -729,6 +744,11 @@ begin
Exit;
end;
cert := SSLGetPeerCertificate(Fssl);
+ if not assigned(cert) then
+ begin
+ Result := '';
+ Exit;
+ end;
b := BioNew(BioSMem);
try
X509Print(b, cert);
diff --git a/ssl_openssl_lib.pas b/ssl_openssl_lib.pas
index 0a2db22..bb26a8a 100644
--- a/ssl_openssl_lib.pas
+++ b/ssl_openssl_lib.pas
@@ -1,5 +1,5 @@
{==============================================================================|
-| Project : Ararat Synapse | 003.004.000 |
+| Project : Ararat Synapse | 003.004.001 |
|==============================================================================|
| Content: SSL support by OpenSSL |
|==============================================================================|
@@ -76,10 +76,8 @@ uses
System.Text,
{$ENDIF}
Classes,
-{$IFDEF LINUX}
- {$IFDEF FPC}
synafpc,
- {$ENDIF}
+{$IFNDEF WIN32}
Libc, SysUtils;
{$ELSE}
Windows;
@@ -97,7 +95,7 @@ const
{$ENDIF}
{$ELSE}
var
- {$IFDEF LINUX}
+ {$IFNDEF WIN32}
DLLSSLName: string = 'libssl.so';
DLLUtilName: string = 'libcrypto.so';
{$ELSE}
@@ -205,8 +203,8 @@ const
EVP_PKEY_RSA = 6;
var
- SSLLibHandle: Integer = 0;
- SSLUtilHandle: Integer = 0;
+ SSLLibHandle: TLibHandle = 0;
+ SSLUtilHandle: TLibHandle = 0;
SSLLibFile: string = '';
SSLUtilFile: string = '';
diff --git a/ssl_sbb.pas b/ssl_sbb.pas
new file mode 100644
index 0000000..5692fd6
--- /dev/null
+++ b/ssl_sbb.pas
@@ -0,0 +1,594 @@
+{==============================================================================|
+| Project : Ararat Synapse | 001.000.001 |
+|==============================================================================|
+| Content: SSL support for SecureBlackBox |
+|==============================================================================|
+| Copyright (c)1999-2005, Lukas Gebauer |
+| All rights reserved. |
+| |
+| Redistribution and use in source and binary forms, with or without |
+| modification, are permitted provided that the following conditions are met: |
+| |
+| Redistributions of source code must retain the above copyright notice, this |
+| list of conditions and the following disclaimer. |
+| |
+| Redistributions in binary form must reproduce the above copyright notice, |
+| this list of conditions and the following disclaimer in the documentation |
+| and/or other materials provided with the distribution. |
+| |
+| Neither the name of Lukas Gebauer nor the names of its contributors may |
+| be used to endorse or promote products derived from this software without |
+| specific prior written permission. |
+| |
+| THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" |
+| AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE |
+| IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE |
+| ARE DISCLAIMED. IN NO EVENT SHALL THE REGENTS OR CONTRIBUTORS BE LIABLE FOR |
+| ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL |
+| DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR |
+| SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER |
+| CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT |
+| LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY |
+| OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH |
+| DAMAGE. |
+|==============================================================================|
+| The Initial Developer of the Original Code is Lukas Gebauer (Czech Republic).|
+| Portions created by Lukas Gebauer are Copyright (c)2005. |
+| All Rights Reserved. |
+|==============================================================================|
+| Contributor(s): |
+| Allen Drennan (adrennan@wiredred.com) |
+|==============================================================================|
+| History: see HISTORY.HTM from distribution package |
+| (Found at URL: http://www.ararat.cz/synapse/) |
+|==============================================================================}
+
+{:@abstract(SSL plugin for Eldos SecureBlackBox)
+
+For handling keys and certificates you can use this properties:
+@link(TCustomSSL.CertCAFile), @link(TCustomSSL.CertCA),
+@link(TCustomSSL.TrustCertificateFile), @link(TCustomSSL.TrustCertificate),
+@link(TCustomSSL.PrivateKeyFile), @link(TCustomSSL.PrivateKey),
+@link(TCustomSSL.CertificateFile), @link(TCustomSSL.Certificate),
+@link(TCustomSSL.PFXFile). For usage of this properties and for possible formats
+of keys and certificates refer to SecureBlackBox documentation.
+}
+
+{$IFDEF FPC}
+ {$MODE DELPHI}
+{$ENDIF}
+{$H+}
+
+unit ssl_sbb;
+
+interface
+
+uses
+ SysUtils, Classes, Windows, blcksock, synsock, synautil, synacode,
+ SBClient, SBServer, SBX509, SBWinCertStorage, SBCustomCertStorage,
+ SBUtils, SBConstants, SBSessionPool;
+
+const
+ DEFAULT_RECV_BUFFER=32768;
+
+type
+ {:@abstract(class implementing SecureBlackbox SSL plugin.)
+ Instance of this class will be created for each @link(TTCPBlockSocket).
+ You not need to create instance of this class, all is done by Synapse itself!}
+ TSSLSBB=class(TCustomSSL)
+ protected
+ FServer: Boolean;
+ FElSecureClient:TElSecureClient;
+ FElSecureServer:TElSecureServer;
+ FElCertStorage:TElMemoryCertStorage;
+ FElX509Certificate:TElX509Certificate;
+ private
+ FRecvBuffer:String;
+ FRecvBuffers:String;
+ FRecvDecodedBuffers:String;
+ function Init(Server:Boolean):Boolean;
+ function DeInit:Boolean;
+ function Prepare(Server:Boolean):Boolean;
+ procedure OnError(Sender:TObject; ErrorCode:Integer; Fatal:Boolean; Remote:Boolean);
+ procedure OnSend(Sender:TObject;Buffer:Pointer;Size:LongInt);
+ procedure OnReceive(Sender:TObject;Buffer:Pointer;MaxSize:LongInt;out Written:LongInt);
+ procedure OnData(Sender:TObject;Buffer:Pointer;Size:LongInt);
+ public
+ constructor Create(const Value: TTCPBlockSocket); override;
+ destructor Destroy; override;
+ {:See @inherited}
+ function LibVersion: String; override;
+ {:See @inherited}
+ function LibName: String; override;
+ {:See @inherited and @link(ssl_sbb) for more details.}
+ function Connect: boolean; override;
+ {:See @inherited and @link(ssl_sbb) for more details.}
+ function Accept: boolean; override;
+ {:See @inherited}
+ function Shutdown: boolean; override;
+ {:See @inherited}
+ function BiShutdown: boolean; override;
+ {:See @inherited}
+ function SendBuffer(Buffer: TMemory; Len: Integer): Integer; override;
+ {:See @inherited}
+ function RecvBuffer(Buffer: TMemory; Len: Integer): Integer; override;
+ {:See @inherited}
+ function WaitingData: Integer; override;
+ {:See @inherited}
+ function GetSSLVersion: string; override;
+ {:See @inherited}
+ function GetPeerSubject: string; override;
+ {:See @inherited}
+ function GetPeerIssuer: string; override;
+ {:See @inherited}
+ function GetPeerName: string; override;
+ {:See @inherited}
+ function GetPeerFingerprint: string; override;
+ {:See @inherited}
+ function GetCertInfo: string; override;
+ published
+ property ELSecureClient:TElSecureClient read FElSecureClient write FElSecureClient;
+ property ELSecureServer:TElSecureServer read FElSecureServer write FElSecureServer;
+ end;
+
+implementation
+
+// on error
+procedure TSSLSBB.OnError(Sender:TObject; ErrorCode:Integer; Fatal:Boolean; Remote:Boolean);
+
+begin
+ FLastErrorDesc:='';
+ FLastError:=ErrorCode;
+end;
+
+// on send
+procedure TSSLSBB.OnSend(Sender:TObject;Buffer:Pointer;Size:LongInt);
+
+var
+ lResult:Integer;
+
+begin
+ lResult:=Send(FSocket.Socket,Buffer,Size,0);
+ if lResult=SOCKET_ERROR then
+ begin
+ FLastErrorDesc:='';
+ FLastError:=WSAGetLastError;
+ end;
+end;
+
+// on receive
+procedure TSSLSBB.OnReceive(Sender:TObject;Buffer:Pointer;MaxSize:LongInt;out Written:LongInt);
+
+begin
+ if Length(FRecvBuffers)<=MaxSize then
+ begin
+ Written:=Length(FRecvBuffers);
+ Move(FRecvBuffers[1],Buffer^,Written);
+ FRecvBuffers:='';
+ end
+ else
+ begin
+ Written:=MaxSize;
+ Move(FRecvBuffers[1],Buffer^,Written);
+ Delete(FRecvBuffers,1,Written);
+ end;
+end;
+
+// on data
+procedure TSSLSBB.OnData(Sender:TObject;Buffer:Pointer;Size:LongInt);
+
+var
+ lString:String;
+
+begin
+ SetLength(lString,Size);
+ Move(Buffer^,lString[1],Size);
+ FRecvDecodedBuffers:=FRecvDecodedBuffers+lString;
+end;
+
+{ inherited }
+
+constructor TSSLSBB.Create(const Value: TTCPBlockSocket);
+
+begin
+ inherited Create(Value);
+ FServer:=FALSE;
+ FElSecureClient:=NIL;
+ FElSecureServer:=NIL;
+ FElCertStorage:=NIL;
+ FElX509Certificate:=NIL;
+ SetLength(FRecvBuffer,DEFAULT_RECV_BUFFER);
+ FRecvBuffers:='';
+ FRecvDecodedBuffers:='';
+end;
+
+destructor TSSLSBB.Destroy;
+
+begin
+ DeInit;
+ inherited Destroy;
+end;
+
+function TSSLSBB.LibVersion: String;
+
+begin
+ Result:='SecureBlackBox';
+end;
+
+function TSSLSBB.LibName: String;
+
+begin
+ Result:='ssl_sbb';
+end;
+
+function FileToString(lFile:String):String;
+
+var
+ lStream:TMemoryStream;
+
+begin
+ Result:='';
+ lStream:=TMemoryStream.Create;
+ if lStream<>NIL then
+ begin
+ lStream.LoadFromFile(lFile);
+ if lStream.Size>0 then
+ begin
+ lStream.Position:=0;
+ SetLength(Result,lStream.Size);
+ Move(lStream.Memory^,Result[1],lStream.Size);
+ end;
+ lStream.Free;
+ end;
+end;
+
+function TSSLSBB.Init(Server:Boolean):Boolean;
+
+var
+ loop1:Integer;
+ lStream:TMemoryStream;
+ lCertificate,lPrivateKey:String;
+
+begin
+ Result:=FALSE;
+ FServer:=Server;
+
+ // init, certificate
+ if FCertificateFile<>'' then
+ lCertificate:=FileToString(FCertificateFile)
+ else
+ lCertificate:=FCertificate;
+ if FPrivateKeyFile<>'' then
+ lPrivateKey:=FileToString(FPrivateKeyFile)
+ else
+ lPrivateKey:=FPrivateKey;
+ if (lCertificate<>'') and (lPrivateKey<>'') then
+ begin
+ FElX509Certificate:=TElX509Certificate.Create(NIL);
+ if FElX509Certificate<>NIL then
+ begin
+ with FElX509Certificate do
+ begin
+ lStream:=TMemoryStream.Create;
+ try
+ WriteStrToStream(lStream,lCertificate);
+ lStream.Seek(0,soFromBeginning);
+ LoadFromStream(lStream);
+ finally
+ lStream.Free;
+ end;
+ lStream:=TMemoryStream.Create;
+ try
+ WriteStrToStream(lStream,lPrivateKey);
+ lStream.Seek(0,soFromBeginning);
+ LoadKeyFromStream(lStream);
+ finally
+ lStream.Free;
+ end;
+ FElCertStorage:=TElMemoryCertStorage.Create(NIL);
+ if FElCertStorage<>NIL then
+ begin
+ FElCertStorage.Clear;
+ FElCertStorage.Add(FElX509Certificate);
+ end;
+ end;
+ end;
+ end;
+
+ // init, as server
+ if FServer then
+ begin
+ FElSecureServer:=TElSecureServer.Create(NIL);
+ if FElSecureServer<>NIL then
+ begin
+ // init, ciphers
+ for loop1:=SB_SUITE_FIRST to SB_SUITE_LAST do
+ FElSecureServer.CipherSuites[loop1]:=TRUE;
+ FElSecureServer.Versions:=[sbSSL2,sbSSL3,sbTLS1];
+ FElSecureServer.ClientAuthentication:=FALSE;
+ FElSecureServer.OnError:=OnError;
+ FElSecureServer.OnSend:=OnSend;
+ FElSecureServer.OnReceive:=OnReceive;
+ FElSecureServer.OnData:=OnData;
+ FElSecureServer.CertStorage:=FElCertStorage;
+ Result:=TRUE;
+ end;
+ end
+ else
+ // init, as client
+ begin
+ FElSecureClient:=TElSecureClient.Create(NIL);
+ if FElSecureClient<>NIL then
+ begin
+ // init, ciphers
+ for loop1:=SB_SUITE_FIRST to SB_SUITE_LAST do
+ FElSecureClient.CipherSuites[loop1]:=TRUE;
+ FElSecureClient.Versions:=[sbSSL3,sbTLS1];
+ FElSecureClient.OnError:=OnError;
+ FElSecureClient.OnSend:=OnSend;
+ FElSecureClient.OnReceive:=OnReceive;
+ FElSecureClient.OnData:=OnData;
+ FElSecureClient.CertStorage:=FElCertStorage;
+ Result:=TRUE;
+ end;
+ end;
+end;
+
+function TSSLSBB.DeInit:Boolean;
+
+begin
+ Result:=TRUE;
+ if FElSecureServer<>NIL then
+ FreeAndNIL(FElSecureServer);
+ if FElSecureClient<>NIL then
+ FreeAndNIL(FElSecureClient);
+ if FElX509Certificate<>NIL then
+ FreeAndNIL(FElX509Certificate);
+ if FElCertStorage<>NIL then
+ FreeAndNIL(FElCertStorage);
+ FSSLEnabled:=FALSE;
+end;
+
+function TSSLSBB.Prepare(Server:Boolean): Boolean;
+
+begin
+ Result:=FALSE;
+ DeInit;
+ if Init(Server) then
+ Result:=TRUE
+ else
+ DeInit;
+end;
+
+function TSSLSBB.Connect: boolean;
+
+var
+ lResult:Integer;
+
+begin
+ Result:=FALSE;
+ if FSocket.Socket=INVALID_SOCKET then
+ Exit;
+ if Prepare(FALSE) then
+ begin
+ FElSecureClient.Open;
+
+ // wait for open or error
+ while (not FElSecureClient.Active) and
+ (FLastError=0) do
+ begin
+ // data available?
+ if FRecvBuffers<>'' then
+ FElSecureClient.DataAvailable
+ else
+ begin
+ // socket recv
+ lResult:=Recv(FSocket.Socket,@FRecvBuffer[1],Length(FRecvBuffer),0);
+ if lResult=SOCKET_ERROR then
+ begin
+ FLastErrorDesc:='';
+ FLastError:=WSAGetLastError;
+ end
+ else
+ begin
+ if lResult>0 then
+ FRecvBuffers:=FRecvBuffers+Copy(FRecvBuffer,1,lResult)
+ else
+ Break;
+ end;
+ end;
+ end;
+ if FLastError<>0 then
+ Exit;
+ FSSLEnabled:=FElSecureClient.Active;
+ Result:=FSSLEnabled;
+ end;
+end;
+
+function TSSLSBB.Accept: boolean;
+
+var
+ lResult:Integer;
+
+begin
+ Result:=FALSE;
+ if FSocket.Socket=INVALID_SOCKET then
+ Exit;
+ if Prepare(TRUE) then
+ begin
+ FElSecureServer.Open;
+
+ // wait for open or error
+ while (not FElSecureServer.Active) and
+ (FLastError=0) do
+ begin
+ // data available?
+ if FRecvBuffers<>'' then
+ FElSecureServer.DataAvailable
+ else
+ begin
+ // socket recv
+ lResult:=Recv(FSocket.Socket,@FRecvBuffer[1],Length(FRecvBuffer),0);
+ if lResult=SOCKET_ERROR then
+ begin
+ FLastErrorDesc:='';
+ FLastError:=WSAGetLastError;
+ end
+ else
+ begin
+ if lResult>0 then
+ FRecvBuffers:=FRecvBuffers+Copy(FRecvBuffer,1,lResult)
+ else
+ Break;
+ end;
+ end;
+ end;
+ if FLastError<>0 then
+ Exit;
+ FSSLEnabled:=FElSecureServer.Active;
+ Result:=FSSLEnabled;
+ end;
+end;
+
+function TSSLSBB.Shutdown: boolean;
+
+begin
+ Result:=BiShutdown;
+end;
+
+function TSSLSBB.BiShutdown: boolean;
+
+begin
+ DeInit;
+ Result:=TRUE;
+end;
+
+function TSSLSBB.SendBuffer(Buffer: TMemory; Len: Integer): Integer;
+
+begin
+ if FServer then
+ FElSecureServer.SendData(Buffer,Len)
+ else
+ FElSecureClient.SendData(Buffer,Len);
+ Result:=Len;
+end;
+
+function TSSLSBB.RecvBuffer(Buffer: TMemory; Len: Integer): Integer;
+
+begin
+ if Length(FRecvDecodedBuffers)<Len then
+ begin
+ Result:=Length(FRecvDecodedBuffers);
+ Move(FRecvDecodedBuffers[1],Buffer^,Result);
+ FRecvDecodedBuffers:='';
+ end
+ else
+ begin
+ Result:=Len;
+ Move(FRecvDecodedBuffers[1],Buffer^,Result);
+ Delete(FRecvDecodedBuffers,1,Result);
+ end;
+end;
+
+function TSSLSBB.WaitingData: Integer;
+
+var
+ lResult:Integer;
+
+begin
+ // data available?
+ if FRecvBuffers<>'' then
+ begin
+ if FServer then
+ FElSecureServer.DataAvailable
+ else
+ FElSecureClient.DataAvailable;
+ end
+ else
+ begin
+ // socket recv
+ lResult:=Recv(FSocket.Socket,@FRecvBuffer[1],Length(FRecvBuffer),0);
+ if lResult=SOCKET_ERROR then
+ begin
+ FLastErrorDesc:='';
+ FLastError:=WSAGetLastError;
+ end
+ else
+ FRecvBuffers:=FRecvBuffers+Copy(FRecvBuffer,1,lResult);
+
+ // data available?
+ if FRecvBuffers<>'' then
+ begin
+ if FServer then
+ FElSecureServer.DataAvailable
+ else
+ FElSecureClient.DataAvailable;
+ end;
+ end;
+ Result:=Length(FRecvDecodedBuffers);
+end;
+
+function TSSLSBB.GetSSLVersion: string;
+
+begin
+ Result:='SSLv3 or TLSv1';
+end;
+
+function TSSLSBB.GetPeerSubject: string;
+
+begin
+ Result := '';
+// if FServer then
+ // must return subject of the client certificate
+// else
+ // must return subject of the server certificate
+end;
+
+function TSSLSBB.GetPeerName: string;
+
+begin
+ Result := '';
+// if FServer then
+ // must return commonname of the client certificate
+// else
+ // must return commonname of the server certificate
+end;
+
+function TSSLSBB.GetPeerIssuer: string;
+
+begin
+ Result := '';
+// if FServer then
+ // must return issuer of the client certificate
+// else
+ // must return issuer of the server certificate
+end;
+
+function TSSLSBB.GetPeerFingerprint: string;
+
+begin
+ Result := '';
+// if FServer then
+ // must return a unique hash string of the client certificate
+// else
+ // must return a unique hash string of the server certificate
+end;
+
+function TSSLSBB.GetCertInfo: string;
+
+begin
+ Result := '';
+// if FServer then
+ // must return a text representation of the ASN of the client certificate
+// else
+ // must return a text representation of the ASN of the server certificate
+end;
+
+{==============================================================================}
+
+initialization
+ SSLImplementation := TSSLSBB;
+
+finalization
+
+end.
diff --git a/sslinux.pas b/sslinux.pas
index 536c54f..887b666 100644
--- a/sslinux.pas
+++ b/sslinux.pas
@@ -1,5 +1,5 @@
{==============================================================================|
-| Project : Ararat Synapse | 002.000.005 |
+| Project : Ararat Synapse | 002.000.007 |
|==============================================================================|
| Content: Socket Independent Platform Layer - Linux definition include |
|==============================================================================|
@@ -62,10 +62,8 @@ For IPv6 support you must have new API!
interface
uses
- SyncObjs, SysUtils,
- {$IFDEF FPC}
+ SyncObjs, SysUtils, Classes,
synafpc,
- {$ENDIF}
Libc;
function InitSocketInterface(stack: string): Boolean;
@@ -82,6 +80,7 @@ type
pu_long = ^u_long;
pu_short = ^u_short;
TSocket = u_int;
+ TAddrFamily = integer;
TMemory = pointer;
@@ -89,6 +88,14 @@ type
const
DLLStackName = 'libc.so.6';
+ cLocalhost = '127.0.0.1';
+ cAnyHost = '0.0.0.0';
+ cBroadcast = '255.255.255.255';
+ c6Localhost = '::1';
+ c6AnyHost = '::0';
+ c6Broadcast = 'ffff::1';
+ cAnyPort = '0';
+
type
DWORD = Integer;
__fd_mask = LongWord;
@@ -127,20 +134,11 @@ const
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);
+ 0: (S_bytes: packed array [0..3] of byte);
+ 1: (S_addr: u_long);
end;
PSockAddrIn = ^TSockAddrIn;
@@ -159,33 +157,13 @@ type
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);
+ 0: (S6_addr: packed array [0..15] of byte);
+ 1: (u6_addr8: packed array [0..15] of byte);
+ 2: (u6_addr16: packed array [0..7] of word);
+ 3: (u6_addr32: packed array [0..7] of integer);
end;
PSockAddrIn6 = ^TSockAddrIn6;
@@ -200,7 +178,7 @@ type
TIPv6_mreq = record
ipv6mr_multiaddr: TInAddr6; // IPv6 multicast address.
- ipv6mr_interface: u_long; // Interface index.
+ ipv6mr_interface: integer; // Interface index.
padding: u_long;
end;
@@ -378,8 +356,8 @@ type
{ Structure used for manipulating linger option. }
PLinger = ^TLinger;
TLinger = packed record
- l_onoff: u_short;
- l_linger: u_short;
+ l_onoff: integer;
+ l_linger: integer;
end;
const
@@ -530,7 +508,7 @@ type
cdecl;
TListen = function(s: TSocket; backlog: Integer): Integer;
cdecl;
- TIoctlSocket = function(s: TSocket; cmd: DWORD; var arg: u_long): Integer;
+ TIoctlSocket = function(s: TSocket; cmd: DWORD; var arg: integer): Integer;
cdecl;
TInet_ntoa = function(inaddr: TInAddr): PChar;
cdecl;
@@ -644,41 +622,49 @@ function SendTo(s: TSocket; Buf: TMemory; len, flags: Integer; addrto: TVarSin):
function RecvFrom(s: TSocket; Buf: TMemory; len, flags: Integer; var from: TVarSin): Integer;
function Accept(s: TSocket; var addr: TVarSin): TSocket;
+function IsNewApi(Family: integer): Boolean;
+function SetVarSin(var Sin: TVarSin; IP, Port: string; Family, SockProtocol, SockType: integer; PreferIP4: Boolean): integer;
+function GetSinIP(Sin: TVarSin): string;
+function GetSinPort(Sin: TVarSin): Integer;
+procedure ResolveNameToIP(Name: string; Family, SockProtocol, SockType: integer; const IPList: TStrings);
+function ResolveIPToName(IP: string; Family, SockProtocol, SockType: integer): string;
+function ResolvePort(Port: string; Family, SockProtocol, SockType: integer): Word;
+
{==============================================================================}
implementation
var
SynSockCount: Integer = 0;
- LibHandle: THandle = 0;
- Libwship6Handle: THandle = 0;
+ LibHandle: TLibHandle = 0;
+ Libwship6Handle: TLibHandle = 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));
+ Result := ((a^.u6_addr32[0] = 0) and (a^.u6_addr32[1] = 0) and
+ (a^.u6_addr32[2] = 0) and (a^.u6_addr32[3] = 0));
end;
function IN6_IS_ADDR_LOOPBACK(const a: PInAddr6): boolean;
begin
- Result := ((a^.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)));
+ Result := ((a^.u6_addr32[0] = 0) and (a^.u6_addr32[1] = 0) and
+ (a^.u6_addr32[2] = 0) and
+ (a^.u6_addr8[12] = 0) and (a^.u6_addr8[13] = 0) and
+ (a^.u6_addr8[14] = 0) and (a^.u6_addr8[15] = 1));
end;
function IN6_IS_ADDR_LINKLOCAL(const a: PInAddr6): boolean;
begin
- Result := ((a^.s_un_b.s_b1 = u_char($FE)) and (a^.s_un_b.s_b2 = u_char($80)));
+ Result := ((a^.u6_addr8[0] = $FE) and (a^.u6_addr8[1] = $80));
end;
function IN6_IS_ADDR_SITELOCAL(const a: PInAddr6): boolean;
begin
- Result := ((a^.s_un_b.s_b1 = u_char($FE)) and (a^.s_un_b.s_b2 = u_char($C0)));
+ Result := ((a^.u6_addr8[0] = $FE) and (a^.u6_addr8[1] = $C0));
end;
function IN6_IS_ADDR_MULTICAST(const a: PInAddr6): boolean;
begin
- Result := (a^.s_un_b.s_b1 = char($FF));
+ Result := (a^.u6_addr8[0] = $FF);
end;
function IN6_ADDR_EQUAL(const a: PInAddr6; const b: PInAddr6): boolean;
@@ -694,7 +680,7 @@ end;
procedure SET_LOOPBACK_ADDR6 (const a: PInAddr6);
begin
FillChar(a^, sizeof(TInAddr6), 0);
- a^.s_un_b.s_b16 := char(1);
+ a^.u6_addr8[15] := 1;
end;
{=============================================================================}
@@ -851,6 +837,369 @@ begin
Result := ssAccept(s, @addr, x);
end;
+{=============================================================================}
+function IsNewApi(Family: integer): Boolean;
+begin
+ Result := SockEnhancedApi;
+ if not Result then
+ Result := (Family = AF_INET6) and SockWship6Api;
+end;
+
+function SetVarSin(var Sin: TVarSin; IP, Port: string; Family, SockProtocol, SockType: integer; PreferIP4: Boolean): integer;
+type
+ pu_long = ^u_long;
+var
+ ProtoEnt: PProtoEnt;
+ ServEnt: PServEnt;
+ HostEnt: PHostEnt;
+ r: integer;
+ Hints1, Hints2: TAddrInfo;
+ Sin1, Sin2: TVarSin;
+ TwoPass: boolean;
+
+ function GetAddr(const IP, port: string; Hints: TAddrInfo; var Sin: TVarSin): integer;
+ var
+ Addr: PAddrInfo;
+ begin
+ Addr := nil;
+ try
+ FillChar(Sin, Sizeof(Sin), 0);
+ if Hints.ai_socktype = SOCK_RAW then
+ begin
+ Hints.ai_socktype := 0;
+ Hints.ai_protocol := 0;
+ Result := synsock.GetAddrInfo(PChar(IP), nil, @Hints, Addr);
+ end
+ else
+ begin
+ if (IP = cAnyHost) or (IP = c6AnyHost) then
+ begin
+ Hints.ai_flags := AI_PASSIVE;
+ Result := synsock.GetAddrInfo(nil, PChar(Port), @Hints, Addr);
+ end
+ else
+ if (IP = cLocalhost) or (IP = c6Localhost) then
+ begin
+ Result := synsock.GetAddrInfo(nil, PChar(Port), @Hints, Addr);
+ end
+ else
+ begin
+ Result := synsock.GetAddrInfo(PChar(IP), PChar(Port), @Hints, Addr);
+ end;
+ end;
+ if Result = 0 then
+ if (Addr <> nil) then
+ Move(Addr^.ai_addr^, Sin, Addr^.ai_addrlen);
+ finally
+ if Assigned(Addr) then
+ synsock.FreeAddrInfo(Addr);
+ end;
+ end;
+
+begin
+ Result := 0;
+ FillChar(Sin, Sizeof(Sin), 0);
+ if not IsNewApi(family) then
+ begin
+ SynSockCS.Enter;
+ try
+ Sin.sin_family := AF_INET;
+ ProtoEnt := synsock.GetProtoByNumber(SockProtocol);
+ 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))
+ 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
+ begin
+ HostEnt := synsock.GetHostByName(PChar(IP));
+ Result := synsock.WSAGetLastError;
+ if HostEnt <> nil then
+ Sin.sin_addr.S_addr := u_long(Pu_long(HostEnt^.h_addr_list^)^);
+ end;
+ end;
+ finally
+ SynSockCS.Leave;
+ end;
+ end
+ else
+ begin
+ FillChar(Hints1, Sizeof(Hints1), 0);
+ FillChar(Hints2, Sizeof(Hints2), 0);
+ TwoPass := False;
+ if Family = AF_UNSPEC then
+ begin
+ if PreferIP4 then
+ begin
+ Hints1.ai_family := AF_INET;
+ Hints2.ai_family := AF_INET6;
+ TwoPass := True;
+ end
+ else
+ begin
+ Hints2.ai_family := AF_INET;
+ Hints1.ai_family := AF_INET6;
+ TwoPass := True;
+ end;
+ end
+ else
+ Hints1.ai_family := Family;
+
+ Hints1.ai_socktype := SockType;
+ Hints1.ai_protocol := SockProtocol;
+ Hints2.ai_socktype := Hints1.ai_socktype;
+ Hints2.ai_protocol := Hints1.ai_protocol;
+
+ r := GetAddr(IP, Port, Hints1, Sin1);
+ Result := r;
+ sin := sin1;
+ if r <> 0 then
+ if TwoPass then
+ begin
+ r := GetAddr(IP, Port, Hints2, Sin2);
+ Result := r;
+ if r = 0 then
+ sin := sin2;
+ end;
+ end;
+end;
+
+function GetSinIP(Sin: TVarSin): string;
+var
+ p: PChar;
+ host, serv: string;
+ hostlen, servlen: integer;
+ r: integer;
+begin
+ Result := '';
+ if not IsNewApi(Sin.AddressFamily) then
+ begin
+ p := synsock.inet_ntoa(Sin.sin_addr);
+ if p <> nil then
+ Result := p;
+ end
+ else
+ begin
+ hostlen := NI_MAXHOST;
+ servlen := NI_MAXSERV;
+ setlength(host, hostlen);
+ setlength(serv, servlen);
+ r := getnameinfo(@sin, SizeOfVarSin(sin), PChar(host), hostlen,
+ PChar(serv), servlen, NI_NUMERICHOST + NI_NUMERICSERV);
+ if r = 0 then
+ Result := PChar(host);
+ end;
+end;
+
+function GetSinPort(Sin: TVarSin): Integer;
+begin
+ if (Sin.sin_family = AF_INET6) then
+ Result := synsock.ntohs(Sin.sin6_port)
+ else
+ Result := synsock.ntohs(Sin.sin_port);
+end;
+
+procedure ResolveNameToIP(Name: string; Family, SockProtocol, SockType: integer; const IPList: TStrings);
+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;
+ i: Integer;
+ s: string;
+ InAddr: TInAddr;
+begin
+ IPList.Clear;
+ if not IsNewApi(Family) then
+ begin
+ 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
+ PAdrPtr := PAPInAddr(RemoteHost^.h_addr_list);
+ i := 0;
+ while PAdrPtr^[i] <> nil do
+ begin
+ InAddr := PAdrPtr^[i]^;
+ s := Format('%d.%d.%d.%d', [InAddr.S_bytes[0], InAddr.S_bytes[1],
+ InAddr.S_bytes[2], InAddr.S_bytes[3]]);
+ IPList.Add(s);
+ Inc(i);
+ end;
+ end;
+ finally
+ SynSockCS.Leave;
+ end;
+ end
+ else
+ IPList.Add(Name);
+ end
+ else
+ begin
+ Addr := nil;
+ try
+ FillChar(Hints, Sizeof(Hints), 0);
+ Hints.ai_family := AF_UNSPEC;
+ Hints.ai_socktype := SockType;
+ Hints.ai_protocol := SockProtocol;
+ 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(((Family = AF_INET6) and (AddrNext^.ai_family = AF_INET))
+ or ((Family = AF_INET) and (AddrNext^.ai_family = AF_INET6))) then
+ begin
+ hostlen := NI_MAXHOST;
+ servlen := NI_MAXSERV;
+ setlength(host, hostlen);
+ setlength(serv, servlen);
+ r := 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 ResolvePort(Port: string; Family, SockProtocol, SockType: integer): Word;
+var
+ ProtoEnt: PProtoEnt;
+ ServEnt: PServEnt;
+ Hints: TAddrInfo;
+ Addr: PAddrInfo;
+ r: integer;
+begin
+ Result := 0;
+ if not IsNewApi(Family) then
+ begin
+ SynSockCS.Enter;
+ try
+ ProtoEnt := synsock.GetProtoByNumber(SockProtocol);
+ ServEnt := nil;
+ if ProtoEnt <> nil then
+ ServEnt := synsock.GetServByName(PChar(Port), ProtoEnt^.p_name);
+ if ServEnt = nil then
+ Result := StrToIntDef(Port, 0)
+ else
+ Result := synsock.htons(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 := SockType;
+ Hints.ai_protocol := Sockprotocol;
+ Hints.ai_flags := AI_PASSIVE;
+ r := synsock.GetAddrInfo(nil, PChar(Port), @Hints, Addr);
+ if (r = 0) and Assigned(Addr) 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 ResolveIPToName(IP: string; Family, SockProtocol, SockType: integer): 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(Family) then
+ begin
+ 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 := SockType;
+ Hints.ai_protocol := SockProtocol;
+ Hints.ai_flags := 0;
+ r := synsock.GetAddrInfo(PChar(IP), nil, @Hints, Addr);
+ if (r = 0) and Assigned(Addr)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;
+
{=============================================================================}
function InitSocketInterface(stack: string): Boolean;
diff --git a/sswin32.pas b/sswin32.pas
index 6964718..2e0824c 100644
--- a/sswin32.pas
+++ b/sswin32.pas
@@ -241,7 +241,7 @@ For IPv6 support you must have new API!
interface
uses
- SyncObjs, SysUtils,
+ SyncObjs, SysUtils, Classes,
Windows;
function InitSocketInterface(stack: string): Boolean;
@@ -262,6 +262,7 @@ type
pu_long = ^u_long;
pu_short = ^u_short;
TSocket = u_int;
+ TAddrFamily = integer;
TMemory = pointer;
@@ -273,6 +274,15 @@ const
{$ENDIF}
DLLwship6 = 'wship6.dll';
+ cLocalhost = '127.0.0.1';
+ cAnyHost = '0.0.0.0';
+ cBroadcast = '255.255.255.255';
+ c6Localhost = '::1';
+ c6AnyHost = '::0';
+ c6Broadcast = 'ffff::1';
+ cAnyPort = '0';
+
+
const
FD_SETSIZE = 64;
type
@@ -307,20 +317,12 @@ const
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);
+ 0: (S_bytes: packed array [0..3] of byte);
+ 1: (S_addr: u_long);
end;
PSockAddrIn = ^TSockAddrIn;
@@ -339,33 +341,13 @@ type
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);
+ 0: (S6_addr: packed array [0..15] of byte);
+ 1: (u6_addr8: packed array [0..15] of byte);
+ 2: (u6_addr16: packed array [0..7] of word);
+ 3: (u6_addr32: packed array [0..7] of integer);
end;
PSockAddrIn6 = ^TSockAddrIn6;
@@ -380,8 +362,8 @@ type
TIPv6_mreq = record
ipv6mr_multiaddr: TInAddr6; // IPv6 multicast address.
- ipv6mr_interface: u_long; // Interface index.
- padding: u_long;
+ ipv6mr_interface: integer; // Interface index.
+ padding: integer;
end;
PHostEnt = ^THostEnt;
@@ -807,7 +789,7 @@ type
stdcall;
TListen = function(s: TSocket; backlog: Integer): Integer;
stdcall;
- TIoctlSocket = function(s: TSocket; cmd: DWORD; var arg: u_long): Integer;
+ TIoctlSocket = function(s: TSocket; cmd: DWORD; var arg: Integer): Integer;
stdcall;
TInet_ntoa = function(inaddr: TInAddr): PChar;
stdcall;
@@ -930,6 +912,14 @@ function SendTo(s: TSocket; Buf: TMemory; len, flags: Integer; addrto: TVarSin):
function RecvFrom(s: TSocket; Buf: TMemory; len, flags: Integer; var from: TVarSin): Integer;
function Accept(s: TSocket; var addr: TVarSin): TSocket;
+function IsNewApi(Family: integer): Boolean;
+function SetVarSin(var Sin: TVarSin; IP, Port: string; Family, SockProtocol, SockType: integer; PreferIP4: Boolean): integer;
+function GetSinIP(Sin: TVarSin): string;
+function GetSinPort(Sin: TVarSin): Integer;
+procedure ResolveNameToIP(Name: string; Family, SockProtocol, SockType: integer; const IPList: TStrings);
+function ResolveIPToName(IP: string; Family, SockProtocol, SockType: integer): string;
+function ResolvePort(Port: string; Family, SockProtocol, SockType: integer): Word;
+
{==============================================================================}
implementation
@@ -940,31 +930,31 @@ var
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));
+ Result := ((a^.u6_addr32[0] = 0) and (a^.u6_addr32[1] = 0) and
+ (a^.u6_addr32[2] = 0) and (a^.u6_addr32[3] = 0));
end;
function IN6_IS_ADDR_LOOPBACK(const a: PInAddr6): boolean;
begin
- Result := ((a^.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)));
+ Result := ((a^.u6_addr32[0] = 0) and (a^.u6_addr32[1] = 0) and
+ (a^.u6_addr32[2] = 0) and
+ (a^.u6_addr8[12] = 0) and (a^.u6_addr8[13] = 0) and
+ (a^.u6_addr8[14] = 0) and (a^.u6_addr8[15] = 1));
end;
function IN6_IS_ADDR_LINKLOCAL(const a: PInAddr6): boolean;
begin
- Result := ((a^.s_un_b.s_b1 = u_char($FE)) and (a^.s_un_b.s_b2 = u_char($80)));
+ Result := ((a^.u6_addr8[0] = $FE) and (a^.u6_addr8[1] = $80));
end;
function IN6_IS_ADDR_SITELOCAL(const a: PInAddr6): boolean;
begin
- Result := ((a^.s_un_b.s_b1 = u_char($FE)) and (a^.s_un_b.s_b2 = u_char($C0)));
+ Result := ((a^.u6_addr8[0] = $FE) and (a^.u6_addr8[1] = $C0));
end;
function IN6_IS_ADDR_MULTICAST(const a: PInAddr6): boolean;
begin
- Result := (a^.s_un_b.s_b1 = char($FF));
+ Result := (a^.u6_addr8[0] = $FF);
end;
function IN6_ADDR_EQUAL(const a: PInAddr6; const b: PInAddr6): boolean;
@@ -980,7 +970,7 @@ end;
procedure SET_LOOPBACK_ADDR6 (const a: PInAddr6);
begin
FillChar(a^, sizeof(TInAddr6), 0);
- a^.s_un_b.s_b16 := char(1);
+ a^.u6_addr8[15] := 1;
end;
{=============================================================================}
@@ -1109,6 +1099,369 @@ begin
Result := ssAccept(s, @addr, x);
end;
+{=============================================================================}
+function IsNewApi(Family: integer): Boolean;
+begin
+ Result := SockEnhancedApi;
+ if not Result then
+ Result := (Family = AF_INET6) and SockWship6Api;
+end;
+
+function SetVarSin(var Sin: TVarSin; IP, Port: string; Family, SockProtocol, SockType: integer; PreferIP4: Boolean): integer;
+type
+ pu_long = ^u_long;
+var
+ ProtoEnt: PProtoEnt;
+ ServEnt: PServEnt;
+ HostEnt: PHostEnt;
+ r: integer;
+ Hints1, Hints2: TAddrInfo;
+ Sin1, Sin2: TVarSin;
+ TwoPass: boolean;
+
+ function GetAddr(const IP, port: string; Hints: TAddrInfo; var Sin: TVarSin): integer;
+ var
+ Addr: PAddrInfo;
+ begin
+ Addr := nil;
+ try
+ FillChar(Sin, Sizeof(Sin), 0);
+ if Hints.ai_socktype = SOCK_RAW then
+ begin
+ Hints.ai_socktype := 0;
+ Hints.ai_protocol := 0;
+ Result := synsock.GetAddrInfo(PChar(IP), nil, @Hints, Addr);
+ end
+ else
+ begin
+ if (IP = cAnyHost) or (IP = c6AnyHost) then
+ begin
+ Hints.ai_flags := AI_PASSIVE;
+ Result := synsock.GetAddrInfo(nil, PChar(Port), @Hints, Addr);
+ end
+ else
+ if (IP = cLocalhost) or (IP = c6Localhost) then
+ begin
+ Result := synsock.GetAddrInfo(nil, PChar(Port), @Hints, Addr);
+ end
+ else
+ begin
+ Result := synsock.GetAddrInfo(PChar(IP), PChar(Port), @Hints, Addr);
+ end;
+ end;
+ if Result = 0 then
+ if (Addr <> nil) then
+ Move(Addr^.ai_addr^, Sin, Addr^.ai_addrlen);
+ finally
+ if Assigned(Addr) then
+ synsock.FreeAddrInfo(Addr);
+ end;
+ end;
+
+begin
+ Result := 0;
+ FillChar(Sin, Sizeof(Sin), 0);
+ if not IsNewApi(family) then
+ begin
+ SynSockCS.Enter;
+ try
+ Sin.sin_family := AF_INET;
+ ProtoEnt := synsock.GetProtoByNumber(SockProtocol);
+ 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))
+ 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
+ begin
+ HostEnt := synsock.GetHostByName(PChar(IP));
+ Result := synsock.WSAGetLastError;
+ if HostEnt <> nil then
+ Sin.sin_addr.S_addr := u_long(Pu_long(HostEnt^.h_addr_list^)^);
+ end;
+ end;
+ finally
+ SynSockCS.Leave;
+ end;
+ end
+ else
+ begin
+ FillChar(Hints1, Sizeof(Hints1), 0);
+ FillChar(Hints2, Sizeof(Hints2), 0);
+ TwoPass := False;
+ if Family = AF_UNSPEC then
+ begin
+ if PreferIP4 then
+ begin
+ Hints1.ai_family := AF_INET;
+ Hints2.ai_family := AF_INET6;
+ TwoPass := True;
+ end
+ else
+ begin
+ Hints2.ai_family := AF_INET;
+ Hints1.ai_family := AF_INET6;
+ TwoPass := True;
+ end;
+ end
+ else
+ Hints1.ai_family := Family;
+
+ Hints1.ai_socktype := SockType;
+ Hints1.ai_protocol := SockProtocol;
+ Hints2.ai_socktype := Hints1.ai_socktype;
+ Hints2.ai_protocol := Hints1.ai_protocol;
+
+ r := GetAddr(IP, Port, Hints1, Sin1);
+ Result := r;
+ sin := sin1;
+ if r <> 0 then
+ if TwoPass then
+ begin
+ r := GetAddr(IP, Port, Hints2, Sin2);
+ Result := r;
+ if r = 0 then
+ sin := sin2;
+ end;
+ end;
+end;
+
+function GetSinIP(Sin: TVarSin): string;
+var
+ p: PChar;
+ host, serv: string;
+ hostlen, servlen: integer;
+ r: integer;
+begin
+ Result := '';
+ if not IsNewApi(Sin.AddressFamily) then
+ begin
+ p := synsock.inet_ntoa(Sin.sin_addr);
+ if p <> nil then
+ Result := p;
+ end
+ else
+ begin
+ hostlen := NI_MAXHOST;
+ servlen := NI_MAXSERV;
+ setlength(host, hostlen);
+ setlength(serv, servlen);
+ r := getnameinfo(@sin, SizeOfVarSin(sin), PChar(host), hostlen,
+ PChar(serv), servlen, NI_NUMERICHOST + NI_NUMERICSERV);
+ if r = 0 then
+ Result := PChar(host);
+ end;
+end;
+
+function GetSinPort(Sin: TVarSin): Integer;
+begin
+ if (Sin.sin_family = AF_INET6) then
+ Result := synsock.ntohs(Sin.sin6_port)
+ else
+ Result := synsock.ntohs(Sin.sin_port);
+end;
+
+procedure ResolveNameToIP(Name: string; Family, SockProtocol, SockType: integer; const IPList: TStrings);
+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;
+ i: Integer;
+ s: string;
+ InAddr: TInAddr;
+begin
+ IPList.Clear;
+ if not IsNewApi(Family) then
+ begin
+ 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
+ PAdrPtr := PAPInAddr(RemoteHost^.h_addr_list);
+ i := 0;
+ while PAdrPtr^[i] <> nil do
+ begin
+ InAddr := PAdrPtr^[i]^;
+ s := Format('%d.%d.%d.%d', [InAddr.S_bytes[0], InAddr.S_bytes[1],
+ InAddr.S_bytes[2], InAddr.S_bytes[3]]);
+ IPList.Add(s);
+ Inc(i);
+ end;
+ end;
+ finally
+ SynSockCS.Leave;
+ end;
+ end
+ else
+ IPList.Add(Name);
+ end
+ else
+ begin
+ Addr := nil;
+ try
+ FillChar(Hints, Sizeof(Hints), 0);
+ Hints.ai_family := AF_UNSPEC;
+ Hints.ai_socktype := SockType;
+ Hints.ai_protocol := SockProtocol;
+ 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(((Family = AF_INET6) and (AddrNext^.ai_family = AF_INET))
+ or ((Family = AF_INET) and (AddrNext^.ai_family = AF_INET6))) then
+ begin
+ hostlen := NI_MAXHOST;
+ servlen := NI_MAXSERV;
+ setlength(host, hostlen);
+ setlength(serv, servlen);
+ r := 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 ResolvePort(Port: string; Family, SockProtocol, SockType: integer): Word;
+var
+ ProtoEnt: PProtoEnt;
+ ServEnt: PServEnt;
+ Hints: TAddrInfo;
+ Addr: PAddrInfo;
+ r: integer;
+begin
+ Result := 0;
+ if not IsNewApi(Family) then
+ begin
+ SynSockCS.Enter;
+ try
+ ProtoEnt := synsock.GetProtoByNumber(SockProtocol);
+ ServEnt := nil;
+ if ProtoEnt <> nil then
+ ServEnt := synsock.GetServByName(PChar(Port), ProtoEnt^.p_name);
+ if ServEnt = nil then
+ Result := StrToIntDef(Port, 0)
+ else
+ Result := synsock.htons(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 := SockType;
+ Hints.ai_protocol := Sockprotocol;
+ Hints.ai_flags := AI_PASSIVE;
+ r := synsock.GetAddrInfo(nil, PChar(Port), @Hints, Addr);
+ if (r = 0) and Assigned(Addr) 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 ResolveIPToName(IP: string; Family, SockProtocol, SockType: integer): 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(Family) then
+ begin
+ 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 := SockType;
+ Hints.ai_protocol := SockProtocol;
+ Hints.ai_flags := 0;
+ r := synsock.GetAddrInfo(PChar(IP), nil, @Hints, Addr);
+ if (r = 0) and Assigned(Addr)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;
+
{=============================================================================}
function InitSocketInterface(stack: string): Boolean;
diff --git a/synachar.pas b/synachar.pas
index 102fd20..586341e 100644
--- a/synachar.pas
+++ b/synachar.pas
@@ -65,7 +65,7 @@ unit synachar;
interface
uses
-{$IFDEF LINUX}
+{$IFNDEF WIN32}
Libc,
{$ELSE}
Windows,
@@ -1469,7 +1469,7 @@ begin
end;
{==============================================================================}
-{$IFDEF LINUX}
+{$IFNDEF WIN32}
function GetCurCP: TMimeChar;
begin
diff --git a/synafpc.pas b/synafpc.pas
index c31f01e..0370d5e 100644
--- a/synafpc.pas
+++ b/synafpc.pas
@@ -1,9 +1,9 @@
{==============================================================================|
-| Project : Ararat Synapse | 001.000.000 |
+| Project : Ararat Synapse | 001.001.000 |
|==============================================================================|
| Content: Utils for FreePascal compatibility |
|==============================================================================|
-| Copyright (c)1999-2003, Lukas Gebauer |
+| Copyright (c)1999-2006, Lukas Gebauer |
| All rights reserved. |
| |
| Redistribution and use in source and binary forms, with or without |
@@ -33,7 +33,7 @@
| DAMAGE. |
|==============================================================================|
| The Initial Developer of the Original Code is Lukas Gebauer (Czech Republic).|
-| Portions created by Lukas Gebauer are Copyright (c)2003. |
+| Portions created by Lukas Gebauer are Copyright (c)2003-2006. |
| All Rights Reserved. |
|==============================================================================|
| Contributor(s): |
@@ -53,56 +53,79 @@ unit synafpc;
interface
-{$IFDEF LINUX}
- {$IFDEF FPC}
uses
- Libc,
- dynlibs;
-
-type
- HMODULE = Longint;
-
-function LoadLibrary(ModuleName: PChar): HMODULE;
-function FreeLibrary(Module: HMODULE): LongBool;
-function GetProcAddress(Module: HMODULE; Proc: PChar): Pointer;
-function GetModuleFileName(Module: HMODULE; Buffer: PChar; BufLen: Integer): Integer;
-procedure Sleep(milliseconds: Cardinal);
-
+{$IFDEF FPC}
+ dynlibs, sysutils;
+{$ELSE}
+ {$IFDEF WIN32}
+ Windows;
+ {$ELSE}
+ Sysutils;
{$ENDIF}
{$ENDIF}
+{$IFDEF FPC}
+type
+ TLibHandle = dynlibs.TLibHandle;
+
+function LoadLibrary(ModuleName: PChar): TLibHandle;
+function FreeLibrary(Module: TLibHandle): LongBool;
+function GetProcAddress(Module: TLibHandle; Proc: PChar): Pointer;
+function GetModuleFileName(Module: TLibHandle; Buffer: PChar; BufLen: Integer): Integer;
+{$ELSE}
+type
+ {$IFDEF CIL}
+ TLibHandle = Integer;
+ {$ELSE}
+ TLibHandle = HModule;
+ {$ENDIF}
+ {$IFDEF VER100}
+ LongWord = DWord;
+ {$ENDIF}
+{$ENDIF}
+
+procedure Sleep(milliseconds: Cardinal);
+
implementation
{==============================================================================}
-{$IFDEF LINUX}
- {$IFDEF FPC}
-function LoadLibrary(ModuleName: PChar): HMODULE;
-begin
- Result := HMODULE(dynlibs.LoadLibrary(Modulename));
-end;
-
-function FreeLibrary(Module: HMODULE): LongBool;
+{$IFDEF FPC}
+function LoadLibrary(ModuleName: PChar): TLibHandle;
begin
- Result := dynlibs.UnloadLibrary(pointer(Module));
+ Result := dynlibs.LoadLibrary(Modulename);
end;
-function GetProcAddress(Module: HMODULE; Proc: PChar): Pointer;
+function FreeLibrary(Module: TLibHandle): LongBool;
begin
- Result := dynlibs.GetProcedureAddress(pointer(Module), Proc);
+ Result := dynlibs.UnloadLibrary(Module);
end;
-function GetModuleFileName(Module: HMODULE; Buffer: PChar; BufLen: Integer): Integer;
-begin
- Result := 0;
-end;
-
-procedure Sleep(milliseconds: Cardinal);
-begin
- usleep(milliseconds * 1000); // usleep is in microseconds
+function GetProcAddress(Module: TLibHandle; Proc: PChar): Pointer;
+begin
+ Result := dynlibs.GetProcedureAddress(Module, Proc);
end;
-
- {$ENDIF}
+
+function GetModuleFileName(Module: TLibHandle; Buffer: PChar; BufLen: Integer): Integer;
+begin
+ Result := 0;
+end;
+
+{$ELSE}
{$ENDIF}
+procedure Sleep(milliseconds: Cardinal);
+begin
+{$IFDEF WIN32}
+ {$IFDEF FPC}
+ sysutils.sleep(milliseconds);
+ {$ELSE}
+ windows.sleep(milliseconds);
+ {$ENDIF}
+{$ELSE}
+ sysutils.sleep(milliseconds);
+{$ENDIF}
+
+end;
+
end.
diff --git a/synaicnv.pas b/synaicnv.pas
index de1cc4a..72a0623 100644
--- a/synaicnv.pas
+++ b/synaicnv.pas
@@ -62,10 +62,8 @@ uses
System.Runtime.InteropServices,
System.Text,
{$ENDIF}
-{$IFDEF LINUX}
- {$IFDEF FPC}
synafpc,
- {$ENDIF}
+{$IFNDEF WIN32}
Libc, SysUtils;
{$ELSE}
Windows;
@@ -73,7 +71,7 @@ uses
const
- {$IFDEF LINUX}
+ {$IFNDEF WIN32}
DLLIconvName = 'libiconv.so';
{$ELSE}
DLLIconvName = 'iconv.dll';
@@ -89,7 +87,7 @@ type
argptr = iconv_t;
var
- iconvLibHandle: Integer = 0;
+ iconvLibHandle: TLibHandle = 0;
function SynaIconvOpen(const tocode, fromcode: string): iconv_t;
function SynaIconvOpenTranslit(const tocode, fromcode: string): iconv_t;
diff --git a/synaip.pas b/synaip.pas
new file mode 100644
index 0000000..9d93c9c
--- /dev/null
+++ b/synaip.pas
@@ -0,0 +1,390 @@
+{==============================================================================|
+| Project : Ararat Synapse | 001.000.000 |
+|==============================================================================|
+| Content: IP address support procedures and functions |
+|==============================================================================|
+| Copyright (c)2006, Lukas Gebauer |
+| All rights reserved. |
+| |
+| Redistribution and use in source and binary forms, with or without |
+| modification, are permitted provided that the following conditions are met: |
+| |
+| Redistributions of source code must retain the above copyright notice, this |
+| list of conditions and the following disclaimer. |
+| |
+| Redistributions in binary form must reproduce the above copyright notice, |
+| this list of conditions and the following disclaimer in the documentation |
+| and/or other materials provided with the distribution. |
+| |
+| Neither the name of Lukas Gebauer nor the names of its contributors may |
+| be used to endorse or promote products derived from this software without |
+| specific prior written permission. |
+| |
+| THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" |
+| AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE |
+| IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE |
+| ARE DISCLAIMED. IN NO EVENT SHALL THE REGENTS OR CONTRIBUTORS BE LIABLE FOR |
+| ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL |
+| DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR |
+| SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER |
+| CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT |
+| LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY |
+| OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH |
+| DAMAGE. |
+|==============================================================================|
+| The Initial Developer of the Original Code is Lukas Gebauer (Czech Republic).|
+| Portions created by Lukas Gebauer are Copyright (c) 2006. |
+| All Rights Reserved. |
+|==============================================================================|
+| Contributor(s): |
+|==============================================================================|
+| History: see HISTORY.HTM from distribution package |
+| (Found at URL: http://www.ararat.cz/synapse/) |
+|==============================================================================}
+
+{:@abstract(IP adress support procedures and functions)}
+
+{$IFDEF FPC}
+ {$MODE DELPHI}
+{$ENDIF}
+{$Q-}
+{$R-}
+{$H+}
+
+unit synaip;
+
+interface
+
+uses
+ SysUtils, SynaUtil;
+
+type
+{:binary form of IPv6 adress (for string conversion routines)}
+ TIp6Bytes = array [0..15] of Byte;
+{:binary form of IPv6 adress (for string conversion routines)}
+ TIp6Words = array [0..7] of Word;
+
+{:Returns @TRUE, if "Value" is a valid IPv4 address. Cannot be a symbolic Name!}
+function IsIP(const Value: string): Boolean;
+
+{:Returns @TRUE, if "Value" is a valid IPv6 address. Cannot be a symbolic Name!}
+function IsIP6(const Value: string): Boolean;
+
+{:Returns a string with the "Host" ip address converted to binary form.}
+function IPToID(Host: string): string;
+
+{:Convert IPv6 address from their string form to binary byte array.}
+function StrToIp6(value: string): TIp6Bytes;
+
+{:Convert IPv6 address from binary byte array to string form.}
+function Ip6ToStr(value: TIp6Bytes): string;
+
+{:Convert IPv4 address from their string form to binary.}
+function StrToIp(value: string): integer;
+
+{:Convert IPv4 address from binary to string form.}
+function IpToStr(value: integer): string;
+
+{:Convert IPv4 address to reverse form.}
+function ReverseIP(Value: AnsiString): AnsiString;
+
+{:Convert IPv6 address to reverse form.}
+function ReverseIP6(Value: AnsiString): AnsiString;
+
+
+implementation
+
+{==============================================================================}
+
+function IsIP(const Value: string): Boolean;
+var
+ TempIP: string;
+ function ByteIsOk(const Value: string): Boolean;
+ var
+ x, n: integer;
+ begin
+ x := StrToIntDef(Value, -1);
+ Result := (x >= 0) and (x < 256);
+ // X may be in correct range, but value still may not be correct value!
+ // i.e. "$80"
+ if Result then
+ for n := 1 to length(Value) do
+ if not (Value[n] in ['0'..'9']) then
+ begin
+ Result := False;
+ Break;
+ end;
+ end;
+begin
+ TempIP := Value;
+ Result := False;
+ if not ByteIsOk(Fetch(TempIP, '.')) then
+ Exit;
+ if not ByteIsOk(Fetch(TempIP, '.')) then
+ Exit;
+ if not ByteIsOk(Fetch(TempIP, '.')) then
+ Exit;
+ if ByteIsOk(TempIP) then
+ Result := True;
+end;
+
+{==============================================================================}
+
+function IsIP6(const Value: string): Boolean;
+var
+ TempIP: string;
+ s,t: string;
+ x: integer;
+ partcount: integer;
+ zerocount: integer;
+ First: Boolean;
+begin
+ TempIP := Value;
+ Result := False;
+ if Value = '::' then
+ begin
+ Result := True;
+ Exit;
+ end;
+ 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
+ if not((PartCount = 1) and (ZeroCount = 0)) then
+ Result := True;
+ end;
+end;
+
+{==============================================================================}
+function IPToID(Host: string): string;
+var
+ s: string;
+ i, x: Integer;
+begin
+ Result := '';
+ for x := 0 to 3 do
+ begin
+ s := Fetch(Host, '.');
+ i := StrToIntDef(s, 0);
+ Result := Result + Chr(i);
+ end;
+end;
+
+{==============================================================================}
+
+function StrToIp(value: string): integer;
+var
+ s: string;
+ i, x: Integer;
+begin
+ Result := 0;
+ for x := 0 to 3 do
+ begin
+ s := Fetch(value, '.');
+ i := StrToIntDef(s, 0);
+ Result := (256 * Result) + i;
+ end;
+end;
+
+{==============================================================================}
+
+function IpToStr(value: integer): string;
+var
+ x1, x2: word;
+ y1, y2: byte;
+begin
+ Result := '';
+ x1 := value div $10000;
+ x2 := value mod $10000;
+ y1 := x1 div $100;
+ y2 := x1 mod $100;
+ Result := inttostr(y1) + '.' + inttostr(y2) + '.';
+ y1 := x2 div $100;
+ y2 := x2 mod $100;
+ Result := Result + inttostr(y1) + '.' + inttostr(y2);
+end;
+
+{==============================================================================}
+
+function StrToIp6(Value: string): TIp6Bytes;
+var
+ IPv6: TIp6Words;
+ Index: Integer;
+ ZeroAt: Integer;
+ n: integer;
+ b1, b2: byte;
+ s: string;
+ x: integer;
+begin
+ for n := 0 to 15 do
+ Result[n] := 0;
+ for n := 0 to 7 do
+ Ipv6[n] := 0;
+ Index := 0;
+ ZeroAt := -1;
+
+ while Value <> '' do
+ begin
+ if Index > 7 then
+ Exit;
+ s := fetch(value, ':');
+ if s = '@' then
+ break;
+ if s = '' then
+ begin
+ ZeroAt := Index;
+ IPv6[Index] := 0;
+ end
+ else
+ begin
+ x := StrToIntDef('$' + s, -1);
+ if (x > 65535) or (x < 0) then
+ Exit;
+ IPv6[Index] := x;
+ end;
+ Inc(Index);
+ end;
+ if ZeroAt >= 0 then
+ Begin
+ x := Index - ZeroAt - 1;
+ for n := 1 to x do
+ IPv6[7 - n + 1] := Ipv6[ZeroAt + x - 1 + n];
+ for n := ZeroAt + 1 to Index - 1 do
+ IPv6[n] := 0;
+ End;
+ for n := 0 to 7 do
+ begin
+ b1 := ipv6[n] div 256;
+ b2 := ipv6[n] mod 256;
+ Result[n * 2] := b1;
+ Result[(n * 2) + 1] := b2;
+ end;
+end;
+
+{==============================================================================}
+//based on routine by the Free Pascal development team
+function Ip6ToStr(value: TIp6Bytes): string;
+var
+ i, x: byte;
+ zr1,zr2: set of byte;
+ zc1,zc2: byte;
+ have_skipped: boolean;
+ ip6w: TIp6words;
+begin
+ zr1 := [];
+ zr2 := [];
+ zc1 := 0;
+ zc2 := 0;
+ for i := 0 to 7 do
+ begin
+ x := i * 2;
+ ip6w[i] := value[x] * 256 + value[x + 1];
+ if ip6w[i] = 0 then
+ begin
+ include(zr2, i);
+ inc(zc2);
+ end
+ else
+ begin
+ if zc1 < zc2 then
+ begin
+ zc1 := zc2;
+ zr1 := zr2;
+ zc2 := 0;
+ zr2 := [];
+ end;
+ end;
+ end;
+ if zc1 < zc2 then
+ begin
+ zr1 := zr2;
+ end;
+ SetLength(Result, 8*5-1);
+ SetLength(Result, 0);
+ have_skipped := false;
+ for i := 0 to 7 do
+ begin
+ if not(i in zr1) then
+ begin
+ if have_skipped then
+ begin
+ if Result = '' then
+ Result := '::'
+ else
+ Result := Result + ':';
+ have_skipped := false;
+ end;
+ Result := Result + IntToHex(Ip6w[i], 1) + ':';
+ end
+ else
+ begin
+ have_skipped := true;
+ end;
+ end;
+ if have_skipped then
+ if Result = '' then
+ Result := '::0'
+ else
+ Result := Result + ':';
+
+ if Result = '' then
+ Result := '::0';
+ if not (7 in zr1) then
+ SetLength(Result, Length(Result)-1);
+ Result := LowerCase(result);
+end;
+
+{==============================================================================}
+function ReverseIP(Value: AnsiString): AnsiString;
+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 ReverseIP6(Value: AnsiString): AnsiString;
+var
+ ip6: TIp6bytes;
+ n: integer;
+begin
+ ip6 := StrToIP6(Value);
+ Result := char(ip6[15]);
+ for n := 14 downto 0 do
+ Result := Result + '.' + char(ip6[n]);
+end;
+
+{==============================================================================}
+end.
diff --git a/synamisc.pas b/synamisc.pas
index 312d834..8b861a9 100644
--- a/synamisc.pas
+++ b/synamisc.pas
@@ -1,5 +1,5 @@
{==============================================================================|
-| Project : Ararat Synapse | 001.001.003 |
+| Project : Ararat Synapse | 001.001.004 |
|==============================================================================|
| Content: misc. procedures and functions |
|==============================================================================|
@@ -67,9 +67,6 @@ uses
{$IFDEF LINUX}
Libc;
{$ELSE}
-{$IFDEF FPC}
- winver,
-{$ENDIF}
Windows;
{$ENDIF}
diff --git a/synautil.pas b/synautil.pas
index fab0f16..863fc2f 100644
--- a/synautil.pas
+++ b/synautil.pas
@@ -1,9 +1,9 @@
{==============================================================================|
-| Project : Ararat Synapse | 004.008.001 |
+| Project : Ararat Synapse | 004.010.001 |
|==============================================================================|
| Content: support procedures and functions |
|==============================================================================|
-| Copyright (c)1999-2004, Lukas Gebauer |
+| Copyright (c)1999-2005, Lukas Gebauer |
| All rights reserved. |
| |
| Redistribution and use in source and binary forms, with or without |
@@ -33,7 +33,7 @@
| DAMAGE. |
|==============================================================================|
| The Initial Developer of the Original Code is Lukas Gebauer (Czech Republic).|
-| Portions created by Lukas Gebauer are Copyright (c) 1999-2004. |
+| Portions created by Lukas Gebauer are Copyright (c) 1999-2005. |
| Portions created by Hernan Sanchez are Copyright (c) 2000. |
| All Rights Reserved. |
|==============================================================================|
@@ -58,15 +58,19 @@ unit synautil;
interface
uses
-{$IFDEF LINUX}
- Libc,
-{$ELSE}
+{$IFDEF WIN32}
Windows,
+{$ELSE}
+ {$IFDEF FPC}
+ UnixUtil, Unix, BaseUnix,
+ {$ELSE}
+ Libc,
+ {$ENDIF}
{$ENDIF}
{$IFDEF CIL}
System.IO,
{$ENDIF}
- SysUtils, Classes;
+ SysUtils, Classes, SynaFpc;
{:Return your timezone bias from UTC time in minutes.}
function TimeZoneBias: integer;
@@ -131,11 +135,11 @@ function SetUTTime(Newdt: TDateTime): Boolean;
{:Return current value of system timer with precizion 1 millisecond. Good for
measure time difference.}
-function GetTick: ULong;
+function GetTick: LongWord;
{:Return difference between two timestamps. It working fine only for differences
smaller then maxint. (difference must be smaller then 24 days.)}
-function TickDelta(TickOld, TickNew: ULong): ULong;
+function TickDelta(TickOld, TickNew: LongWord): LongWord;
{:Return two characters, which ordinal values represents the value in byte
format. (High-endian)}
@@ -153,15 +157,6 @@ function CodeLongInt(Value: LongInt): Ansistring;
string to LongInt values.}
function DecodeLongInt(const Value: Ansistring; Index: Integer): LongInt;
-{:Returns @TRUE, if "Value" is a valid IPv4 address. Cannot be a symbolic Name!}
-function IsIP(const Value: string): Boolean;
-
-{:Returns @TRUE, if "Value" is a valid IPv6 address. Cannot be a symbolic Name!}
-function IsIP6(const Value: string): Boolean;
-
-{:Returns a string with the "Host" ip address converted to binary form.}
-function IPToID(Host: string): string;
-
{:Dump binary buffer stored in a string to a result string.}
function DumpStr(const Buffer: Ansistring): string;
@@ -341,19 +336,18 @@ var
{==============================================================================}
function TimeZoneBias: integer;
-{$IFDEF LINUX}
+{$IFNDEF WIN32}
+{$IFNDEF FPC}
var
t: TTime_T;
UT: TUnixTime;
begin
-{$IFNDEF FPC}
__time(@T);
localtime_r(@T, UT);
Result := ut.__tm_gmtoff div 60;
{$ELSE}
- __time(T);
- localtime_r(T, UT);
- Result := ut.tm_gmtoff div 60;
+begin
+ Result := TZSeconds div 60;
{$ENDIF}
{$ELSE}
var
@@ -688,7 +682,7 @@ end;
{==============================================================================}
function GetUTTime: TDateTime;
-{$IFNDEF LINUX}
+{$IFDEF WIN32}
{$IFNDEF FPC}
var
st: TSystemTime;
@@ -711,23 +705,26 @@ begin
result := SystemTimeToDateTime(st);
{$ENDIF}
{$ELSE}
+{$IFNDEF FPC}
var
TV: TTimeVal;
- TZ: Ttimezone;
- PZ: PTimeZone;
begin
- TZ.tz_minuteswest := 0;
- TZ.tz_dsttime := 0;
- PZ := @TZ;
- gettimeofday(TV, PZ);
+ gettimeofday(TV, nil);
Result := UnixDateDelta + (TV.tv_sec + TV.tv_usec / 1000000) / 86400;
+{$ELSE}
+var
+ TV: TimeVal;
+begin
+ fpgettimeofday(@TV, nil);
+ Result := UnixDateDelta + (TV.tv_sec + TV.tv_usec / 1000000) / 86400;
+{$ENDIF}
{$ENDIF}
end;
{==============================================================================}
function SetUTTime(Newdt: TDateTime): Boolean;
-{$IFNDEF LINUX}
+{$IFDEF WIN32}
{$IFNDEF FPC}
var
st: TSystemTime;
@@ -750,6 +747,7 @@ begin
Result := SetSystemTime(stw);
{$ENDIF}
{$ELSE}
+{$IFNDEF FPC}
var
TV: TTimeVal;
d: double;
@@ -764,13 +762,23 @@ begin
TV.tv_sec := trunc(d);
TV.tv_usec := trunc(frac(d) * 1000000);
Result := settimeofday(TV, TZ) <> -1;
+{$ELSE}
+var
+ TV: TimeVal;
+ d: double;
+begin
+ d := (newdt - UnixDateDelta) * 86400;
+ TV.tv_sec := trunc(d);
+ TV.tv_usec := trunc(frac(d) * 1000000);
+ Result := fpsettimeofday(@TV, nil) <> -1;
+{$ENDIF}
{$ENDIF}
end;
{==============================================================================}
-{$IFDEF LINUX}
-function GetTick: ULong;
+{$IFNDEF WIN32}
+function GetTick: LongWord;
var
Stamp: TTimeStamp;
begin
@@ -778,15 +786,31 @@ begin
Result := Stamp.Time;
end;
{$ELSE}
-function GetTick: ULong;
+function GetTick: LongWord;
+var
+ tick, freq: TLargeInteger;
+{$IFDEF VER100}
+ x: TLargeInteger;
+{$ENDIF}
begin
- Result := Windows.GetTickCount;
+ if Windows.QueryPerformanceFrequency(freq) then
+ begin
+ Windows.QueryPerformanceCounter(tick);
+{$IFDEF VER100}
+ x.QuadPart := (tick.QuadPart / freq.QuadPart) * 1000;
+ Result := x.LowPart;
+{$ELSE}
+ Result := Trunc((tick / freq) * 1000) and High(LongWord)
+{$ENDIF}
+ end
+ else
+ Result := Windows.GetTickCount;
end;
{$ENDIF}
{==============================================================================}
-function TickDelta(TickOld, TickNew: ULong): ULong;
+function TickDelta(TickOld, TickNew: LongWord): LongWord;
begin
//if DWord is signed type (older Deplhi),
// then it not work properly on differencies larger then maxint!
@@ -795,8 +819,8 @@ begin
begin
if TickNew < TickOld then
begin
- TickNew := TickNew + ULong(MaxInt) + 1;
- TickOld := TickOld + ULong(MaxInt) + 1;
+ TickNew := TickNew + LongWord(MaxInt) + 1;
+ TickOld := TickOld + LongWord(MaxInt) + 1;
end;
Result := TickNew - TickOld;
if TickNew < TickOld then
@@ -876,103 +900,6 @@ end;
{==============================================================================}
-function IsIP(const Value: string): Boolean;
-var
- TempIP: string;
- function ByteIsOk(const Value: string): Boolean;
- var
- x, n: integer;
- begin
- x := StrToIntDef(Value, -1);
- Result := (x >= 0) and (x < 256);
- // X may be in correct range, but value still may not be correct value!
- // i.e. "$80"
- if Result then
- for n := 1 to length(Value) do
- if not (Value[n] in ['0'..'9']) then
- begin
- Result := False;
- Break;
- end;
- end;
-begin
- TempIP := Value;
- Result := False;
- if not ByteIsOk(Fetch(TempIP, '.')) then
- Exit;
- if not ByteIsOk(Fetch(TempIP, '.')) then
- Exit;
- if not ByteIsOk(Fetch(TempIP, '.')) then
- Exit;
- if ByteIsOk(TempIP) then
- Result := True;
-end;
-
-{==============================================================================}
-
-function IsIP6(const Value: string): Boolean;
-var
- TempIP: string;
- s,t: string;
- x: integer;
- partcount: integer;
- zerocount: integer;
- First: Boolean;
-begin
- 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;
-
-{==============================================================================}
-//Hernan Sanchez
-function IPToID(Host: string): string;
-var
- s: string;
- i, x: Integer;
-begin
- Result := '';
- for x := 1 to 3 do
- begin
- s := Fetch(Host, '.');
- i := StrToIntDef(s, 0);
- Result := Result + Chr(i);
- end;
- i := StrToIntDef(Host, 0);
- Result := Result + Chr(i);
-end;
-
-{==============================================================================}
-
function DumpStr(const Buffer: Ansistring): string;
var
n: Integer;
@@ -1040,6 +967,9 @@ function TrimSPLeft(const S: string): string;
var
I, L: Integer;
begin
+ Result := '';
+ if S = '' then
+ Exit;
L := Length(S);
I := 1;
while (I <= L) and (S[I] = ' ') do
@@ -1053,6 +983,9 @@ function TrimSPRight(const S: string): string;
var
I: Integer;
begin
+ Result := '';
+ if S = '' then
+ Exit;
I := Length(S);
while (I > 0) and (S[I] = ' ') do
Dec(I);
@@ -1471,38 +1404,26 @@ end;
function PosCRLF(const Value: AnsiString; var Terminator: AnsiString): integer;
var
- p1, p2, p3, p4: integer;
-const
- t1 = #$0d + #$0a;
- t2 = #$0a + #$0d;
- t3 = #$0d;
- t4 = #$0a;
+ n, l: integer;
begin
+ Result := -1;
Terminator := '';
- p1 := Pos(t1, Value);
- p2 := Pos(t2, Value);
- p3 := Pos(t3, Value);
- p4 := Pos(t4, Value);
- if p1 > 0 then
- Terminator := t1;
- Result := p1;
- if (p2 > 0) then
- if (Result = 0) or (p2 < Result) then
+ l := length(value);
+ for n := 1 to l do
+ if value[n] in [#$0d, #$0a] then
begin
- Result := p2;
- Terminator := t2;
- end;
- if (p3 > 0) then
- if (Result = 0) or (p3 < Result) then
- begin
- Result := p3;
- Terminator := t3;
- end;
- if (p4 > 0) then
- if (Result = 0) or (p4 < Result) then
- begin
- Result := p4;
- Terminator := t4;
+ Result := n;
+ Terminator := Value[n];
+ if n <> l then
+ case value[n] of
+ #$0d:
+ if value[n + 1] = #$0a then
+ Terminator := #$0d + #$0a;
+ #$0a:
+ if value[n + 1] = #$0d then
+ Terminator := #$0a + #$0d;
+ end;
+ Break;
end;
end;
@@ -1553,7 +1474,7 @@ end;
{$IFNDEF CIL}
function IncPoint(const p: pointer; Value: integer): pointer;
begin
- Result := pointer(integer(p) + Value);
+ Result := PChar(p) + Value;
end;
{$ENDIF}
@@ -1686,7 +1607,7 @@ end;
procedure HeadersToList(const Value: TStrings);
var
- n, x: integer;
+ n, x, y: integer;
s: string;
begin
for n := 0 to Value.Count -1 do
@@ -1695,8 +1616,12 @@ begin
x := Pos(':', s);
if x > 0 then
begin
- s[x] := '=';
- Value[n] := s;
+ y:= Pos('=',s);
+ if not ((y > 0) and (y < x)) then
+ begin
+ s[x] := '=';
+ Value[n] := s;
+ end;
end;
end;
end;
@@ -1775,7 +1700,7 @@ end;
{==============================================================================}
function GetTempFile(const Dir, prefix: AnsiString): AnsiString;
{$IFNDEF FPC}
-{$IFNDEF LINUX}
+{$IFDEF WIN32}
var
Path: AnsiString;
x: integer;
@@ -1785,7 +1710,7 @@ begin
{$IFDEF FPC}
Result := GetTempFileName(Dir, Prefix);
{$ELSE}
- {$IFDEF LINUX}
+ {$IFNDEF WIN32}
Result := tempnam(Pointer(Dir), Pointer(prefix));
{$ELSE}
{$IFDEF CIL}
diff --git a/synsock.pas b/synsock.pas
index 4b4fc46..c4bc977 100644
--- a/synsock.pas
+++ b/synsock.pas
@@ -1,5 +1,5 @@
{==============================================================================|
-| Project : Ararat Synapse | 005.000.000 |
+| Project : Ararat Synapse | 005.001.000 |
|==============================================================================|
| Content: Socket Independent Platform Layer |
|==============================================================================|
@@ -52,13 +52,16 @@ unit synsock;
{$I ssdotnet.pas}
{$ENDIF}
-{$IFDEF LINUX}
- {$I sslinux.pas}
-{$ENDIF}
-
{$IFDEF WIN32}
{$I sswin32.pas}
+{$ELSE}
+ {$IFDEF FPC}
+ {$I ssfpc.pas}
+ {$ELSE}
+ {$I sslinux.pas}
+ {$ENDIF}
{$ENDIF}
+
end.
diff --git a/winver.pp b/winver.pp
deleted file mode 100644
index ae1e140..0000000
--- a/winver.pp
+++ /dev/null
@@ -1,76 +0,0 @@
-{
- $Id: header,v 1.1.2.1 2003/01/05 20:47:31 michael Exp $
- This file is part of the Free Pascal run time library.
- Copyright (c) 2003 by the Free Pascal development team
-
- Windows Version detection functionality.
-
- See the file COPYING.FPC, included in this distribution,
- for details about the copyright.
-
- This program is distributed in the hope that it will be useful,
- but WITHOUT ANY WARRANTY; without even the implied warranty of
- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
-
- **********************************************************************}
-
-{$mode objfpc}
-unit winver;
-
-Interface
-
-Uses Windows;
-
-const
- Win32Platform : Integer = 0;
- Win32MajorVersion : Integer = 0;
- Win32MinorVersion : Integer = 0;
- Win32BuildNumber : Integer = 0;
-
- Win32CSDVersion : string = '';
-
-function CheckWin32Version(Major,Minor : Integer ): Boolean;
-function CheckWin32Version(Major : Integer): Boolean;
-
-Implementation
-
-
-uses sysutils;
-
-procedure InitVersion;
-
-var
- Info: TOSVersionInfo;
-
-begin
- Info.dwOSVersionInfoSize := SizeOf(Info);
- if GetVersionEx(Info) then
- with Info do
- begin
- Win32Platform:=dwPlatformId;
- Win32MajorVersion:=dwMajorVersion;
- Win32MinorVersion:=dwMinorVersion;
- if (Win32Platform=VER_PLATFORM_WIN32_WINDOWS) then
- Win32BuildNumber:=dwBuildNumber and $FFFF
- else
- Win32BuildNumber := dwBuildNumber;
- Win32CSDVersion := StrPas(szCSDVersion);
- end;
-end;
-
-function CheckWin32Version(Major : Integer): Boolean;
-
-begin
- Result:=CheckWin32Version(Major,0)
-end;
-
-function CheckWin32Version(Major,Minor: Integer): Boolean;
-
-begin
- Result := (Win32MajorVersion>Major) or
- ((Win32MajorVersion=Major) and (Win32MinorVersion>=Minor));
-end;
-
-initialization
- InitVersion;
-end.
\ No newline at end of file