paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-04-08 17:48:01 +02:00
Code Issues Packages Projects Releases Wiki Activity

Amiga, AROS, MorphOS: Prevent crash when access socket without TCP/IP Stack running

Browse Source 
git-svn-id: trunk@48805 -
This commit is contained in:
marcus 2021-02-24 19:00:58 +00:00
parent cfa3f4fa8c
commit 53d847f268
4 changed files with 85 additions and 20 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

22
packages/fcl-net/src/amiga/resolve.inc
View File

@ -48,7 +48,7 @@ Type
{ remember, classic style calls are also used on MorphOS, so don't test for AMIGA68K }
{$ifndef AMIGAOS4}
function gethostbyname(Name: PChar location 'a0'): PHostEntry; syscall SocketBase 210;
function fpgethostbyname(Name: PChar location 'a0'): PHostEntry; syscall SocketBase 210;
function getnetbyname(Name: PChar location 'a0'): PNetEntry; syscall SocketBase 222;
function getnetbyaddr(Net: Longint location 'd0'; NetType: Longint location 'd1'): PNetEntry; syscall SocketBase 228;
function getservbyname(Name: PChar location 'a0'; Protocol: PChar location 'a1'): PServEntry; syscall SocketBase 234;
@ -63,7 +63,7 @@ function getservent: PServEntry; syscall SocketBase 564;
{$else AMIGAOS4}
function gethostbyname(const Name: PChar): PHostEntry; syscall ISocket 196;
function fpgethostbyname(const Name: PChar): PHostEntry; syscall ISocket 196;
function getnetbyname(Name: PChar): PNetEntry; syscall ISocket 204;
function getnetbyaddr(Net: Longint; NetType: Longint): PNetEntry; syscall ISocket 208;
function getservbyname(Name: PChar; Protocol: PChar): PServEntry; syscall ISocket 212;
@ -77,12 +77,24 @@ procedure endservent; syscall ISocket 484;
function getservent: PServEntry; syscall ISocket 488;
{$endif AMIGAOS4}
function gethostbyname(Name: PChar): PHostEntry;
begin
if Assigned(SocketBase) then
gethostbyname := fpgethostbyname(Name)
else
gethostbyname := nil;
end;
function gethostbyaddr(Addr: PChar; Len: Longint; HType: Longint): PHostentry;
var
addr1,
addr2: in_addr;
IP: PPLongInt;
begin
gethostbyaddr := nil;
if not Assigned(SocketBase) then
Exit;
//
Addr1 := in_addr(PHostAddr(Addr)^);
Addr2.s_addr := htonl(Addr1.s_addr);
gethostbyaddr := Pointer(bsd_GetHostByAddr(Pointer(@Addr2.s_addr), Len, HType));
@ -101,12 +113,14 @@ end;
function GetDNSError: integer;
begin
GetDNSError:=bsd_Errno;
GetDNSError := 0;
if assigned(SocketBase) then
GetDNSError:=bsd_Errno;
end;
Function InitResolve : Boolean;
begin
Result:=True;
Result:=Assigned(SocketBase);
end;
Function FinalResolve : Boolean;

23
packages/fcl-net/src/aros/resolve.inc
View File

@ -48,7 +48,7 @@ Type
{ C style calls, linked in from Libc }
function gethostbyname(Name: PChar): PHostEntry; syscall SocketBase 35;
function fpgethostbyname(Name: PChar): PHostEntry; syscall SocketBase 35;
function getnetbyname(Name: PChar): PNetEntry; syscall SocketBase 37;
function getnetbyaddr(Net: Longint; NetType: Longint): PNetEntry; syscall SocketBase 38;
function getservbyname(Name: PChar; Protocol: PChar): PServEntry; syscall SocketBase 39;
@ -61,12 +61,25 @@ procedure setservent(StayOpen: longint); syscall SocketBase 92;
procedure endservent; syscall SocketBase 93;
function getservent: PServEntry; syscall SocketBase 94;
function gethostbyname(Name: PChar): PHostEntry;
begin
if Assigned(SocketBase) then
gethostbyname := fpgethostbyname(Name)
else
gethostbyname := nil;
end;
function gethostbyaddr(Addr: PChar; Len: Longint; HType: Longint): PHostentry;
var
addr1,
addr2: in_addr;
IP: PPLongInt;
begin
gethostbyaddr := nil;
if not Assigned(SocketBase) then
Exit;
//
Addr1 := in_addr(PHostAddr(Addr)^);
Addr2.s_addr := htonl(Addr1.s_addr);
gethostbyaddr := Pointer(bsd_GetHostByAddr(Pointer(@Addr2.s_addr), Len, HType));
@ -78,19 +91,21 @@ begin
repeat
ip^^ := ntohl(ip^^);
Inc(IP);
until ip^ = nil;
until ip^ = nil;
end;
end;
end;
function GetDNSError: integer;
begin
GetDNSError:=bsd_Errno;
GetDNSError := 0;
if assigned(SocketBase) then
GetDNSError := bsd_Errno;
end;
Function InitResolve : Boolean;
begin
Result:=True;
Result := Assigned(SocketBase);
end;
Function FinalResolve : Boolean;

22
packages/rtl-extra/src/amiga/sockets.pp
View File

@ -201,12 +201,18 @@ end;
function fpgeterrno: longint; inline;
begin
fpgeterrno := bsd_Errno;
if Assigned(SocketBase) then
fpgeterrno := bsd_Errno
else
fpgeterrno := 0;
end;
function fpClose(d: LongInt): LongInt; inline;
begin
fpClose := bsd_CloseSocket(d);
if Assigned(SocketBase) then
fpClose := bsd_CloseSocket(d)
else
fpClose := -1;
end;
function fpaccept(s: cint; addrx: PSockaddr; Addrlen: PSocklen): cint;
@ -289,8 +295,16 @@ end;
function fpsocket(domain: cint; xtype: cint; protocol: cint): cint;
begin
fpsocket := bsd_socket(domain, xtype, protocol);
internal_socketerror := fpgeterrno;
if Assigned(SocketBase) then
begin
fpsocket := bsd_socket(domain, xtype, protocol);
internal_socketerror := fpgeterrno;
end
else
begin
fpsocket := -1;
internal_socketerror := ESockEPROTONOSUPPORT;
end;
end;

38
packages/rtl-extra/src/aros/sockets.pp
View File

@ -88,7 +88,7 @@ const
SOL_SOCKET = $FFFF;
const
EsockEINTR = 4; // EsysEINTR;
EsockEINTR = 4; // EsysEINTR;
EsockEBADF = 9; // EsysEBADF;
EsockEFAULT = 14; // EsysEFAULT;
EsockEINVAL = 22; //EsysEINVAL;
@ -155,18 +155,24 @@ end;
function fpgeterrno: longint; inline;
begin
fpgeterrno := bsd_Errno;
if Assigned(SocketBase) then
fpgeterrno := bsd_Errno
else
fpgeterrno := 0;
end;
function fpClose(d: LongInt): LongInt; inline;
begin
fpClose := bsd_CloseSocket(d);
if Assigned(SocketBase) then
fpClose := bsd_CloseSocket(d)
else
fpClose := -1;
end;
function fpaccept(s: cint; addrx: PSockaddr; Addrlen: PSocklen): cint;
begin
fpaccept := bsd_accept(s,addrx,addrlen);
internal_socketerror := fpgeterrno;
internal_socketerror := fpgeterrno;
end;
function fpbind(s:cint; addrx: psockaddr; addrlen: tsocklen): cint;
@ -177,8 +183,16 @@ end;
function fpconnect(s:cint; name: psockaddr; namelen: tsocklen): cint;
begin
fpconnect := bsd_connect(s, name, namelen);
internal_socketerror := fpgeterrno;
if Assigned(SocketBase) then
begin
fpconnect := bsd_connect(s, name, namelen);
internal_socketerror := fpgeterrno;
end
else
begin
fpconnect := -1;
internal_socketerror := ESockEPROTONOSUPPORT;
end;
end;
function fpgetpeername (s:cint; name : psockaddr; namelen : psocklen):cint;
@ -243,8 +257,16 @@ end;
function fpsocket(domain: cint; xtype: cint; protocol: cint): cint;
begin
fpsocket := bsd_socket(domain, xtype, protocol);
internal_socketerror := fpgeterrno;
if Assigned(SocketBase) then
begin
fpsocket := bsd_socket(domain, xtype, protocol);
internal_socketerror := fpgeterrno;
end
else
begin
internal_socketerror := ESockEPROTONOSUPPORT;
fpsocket := -1;
end;
end;