paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-04-06 13:28:07 +02:00
Code Issues Packages Projects Releases Wiki Activity

Amiga: sockets, fcl-net, fcl-web included.

Browse Source 
git-svn-id: trunk@28709 -
This commit is contained in:
marcus 2014-09-22 18:12:43 +00:00
parent d37e72dbf9
commit 8c2a1ed026
11 changed files with 409 additions and 27 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

4
.gitattributes vendored
View File

@ -2471,6 +2471,7 @@ packages/fcl-net/examples/testproto.pp svneol=native#text/plain
packages/fcl-net/examples/testsvc.pp svneol=native#text/plain packages/fcl-net/examples/testsvc.pp svneol=native#text/plain
packages/fcl-net/examples/testuri.pp svneol=native#text/plain packages/fcl-net/examples/testuri.pp svneol=native#text/plain
packages/fcl-net/fpmake.pp svneol=native#text/plain packages/fcl-net/fpmake.pp svneol=native#text/plain
packages/fcl-net/src/amiga/resolve.inc svneol=native#text/plain
packages/fcl-net/src/aros/resolve.inc svneol=native#text/plain packages/fcl-net/src/aros/resolve.inc svneol=native#text/plain
packages/fcl-net/src/cnetdb.pp svneol=native#text/plain packages/fcl-net/src/cnetdb.pp svneol=native#text/plain
packages/fcl-net/src/fpsock.pp svneol=native#text/plain packages/fcl-net/src/fpsock.pp svneol=native#text/plain
@ -6647,6 +6648,7 @@ packages/rtl-extra/src/aix/clocale.inc svneol=native#text/plain
packages/rtl-extra/src/aix/osdefs.inc svneol=native#text/plain packages/rtl-extra/src/aix/osdefs.inc svneol=native#text/plain
packages/rtl-extra/src/aix/unxsockh.inc svneol=native#text/plain packages/rtl-extra/src/aix/unxsockh.inc svneol=native#text/plain
packages/rtl-extra/src/amiga/printer.pp svneol=native#text/plain packages/rtl-extra/src/amiga/printer.pp svneol=native#text/plain
packages/rtl-extra/src/amiga/sockets.pp svneol=native#text/plain
packages/rtl-extra/src/android/clocale.pp svneol=native#text/plain packages/rtl-extra/src/android/clocale.pp svneol=native#text/plain
packages/rtl-extra/src/android/osdefs.inc svneol=native#text/plain packages/rtl-extra/src/android/osdefs.inc svneol=native#text/plain
packages/rtl-extra/src/android/unixsock.inc svneol=native#text/plain packages/rtl-extra/src/android/unixsock.inc svneol=native#text/plain
@ -14084,7 +14086,7 @@ tests/webtbs/tw2656.pp svneol=native#text/plain
tests/webtbs/tw2659.pp svneol=native#text/plain tests/webtbs/tw2659.pp svneol=native#text/plain
tests/webtbs/tw26599.pp svneol=native#text/pascal tests/webtbs/tw26599.pp svneol=native#text/pascal
tests/webtbs/tw26615.pp svneol=native#text/pascal tests/webtbs/tw26615.pp svneol=native#text/pascal
tests/webtbs/tw26627.pp -text svneol=native#text/plain tests/webtbs/tw26627.pp svneol=native#text/plain
tests/webtbs/tw2666.pp svneol=native#text/plain tests/webtbs/tw2666.pp svneol=native#text/plain
tests/webtbs/tw2668.pp svneol=native#text/plain tests/webtbs/tw2668.pp svneol=native#text/plain
tests/webtbs/tw2669.pp svneol=native#text/plain tests/webtbs/tw2669.pp svneol=native#text/plain

9
.gitignore vendored
View File

@ -1344,6 +1344,15 @@ packages/fcl-net/src/*.o
packages/fcl-net/src/*.ppu packages/fcl-net/src/*.ppu
packages/fcl-net/src/*.s packages/fcl-net/src/*.s
packages/fcl-net/src/Package.fpc packages/fcl-net/src/Package.fpc
packages/fcl-net/src/amiga/*.bak
packages/fcl-net/src/amiga/*.exe
packages/fcl-net/src/amiga/*.o
packages/fcl-net/src/amiga/*.ppu
packages/fcl-net/src/amiga/*.s
packages/fcl-net/src/amiga/Package.fpc
packages/fcl-net/src/amiga/build-stamp.*
packages/fcl-net/src/amiga/fpcmade.*
packages/fcl-net/src/amiga/units
packages/fcl-net/src/aros/*.bak packages/fcl-net/src/aros/*.bak
packages/fcl-net/src/aros/*.exe packages/fcl-net/src/aros/*.exe
packages/fcl-net/src/aros/*.o packages/fcl-net/src/aros/*.o

2
packages/fastcgi/fpmake.pp
View File

@ -24,7 +24,7 @@ begin
P.Email := ''; P.Email := '';
P.Description := 'FastCGI header translation to Pascal'; P.Description := 'FastCGI header translation to Pascal';
P.NeedLibC:= false; P.NeedLibC:= false;
P.OSes := AllUnixOSes+AllWindowsOSes-[qnx]+[aros]; P.OSes := AllUnixOSes+AllWindowsOSes-[qnx]+[amiga,aros];
P.SourcePath.Add('src'); P.SourcePath.Add('src');

6
packages/fcl-net/fpmake.pp
View File

@ -18,7 +18,7 @@ begin
{$endif ALLPACKAGES} {$endif ALLPACKAGES}
P.Version:='2.7.1'; P.Version:='2.7.1';
P.Dependencies.Add('fcl-base'); P.Dependencies.Add('fcl-base');
P.Dependencies.Add('openssl',AllOSes - [aros]); P.Dependencies.Add('openssl',AllOSes - [amiga,aros]);
P.Dependencies.Add('fcl-xml'); P.Dependencies.Add('fcl-xml');
P.Dependencies.Add('fcl-passrc'); P.Dependencies.Add('fcl-passrc');
P.Dependencies.Add('fcl-async',[linux,freebsd,netbsd,openbsd]); P.Dependencies.Add('fcl-async',[linux,freebsd,netbsd,openbsd]);
@ -40,14 +40,14 @@ begin
// IP and Sockets // IP and Sockets
T:=P.Targets.AddUnit('netdb.pp',AllUnixOSes); T:=P.Targets.AddUnit('netdb.pp',AllUnixOSes);
T:=P.Targets.AddUnit('resolve.pp',AllUnixOSes+AllWindowsOSes+[OS2,EMX,aros]); T:=P.Targets.AddUnit('resolve.pp',AllUnixOSes+AllWindowsOSes+[OS2,EMX,amiga,aros]);
with T.Dependencies do with T.Dependencies do
begin begin
AddInclude('resolve.inc'); AddInclude('resolve.inc');
AddUnit('netdb',AllUnixOSes); AddUnit('netdb',AllUnixOSes);
end; end;
T.ResourceStrings := True; T.ResourceStrings := True;
T:=P.Targets.AddUnit('ssockets.pp',AllUnixOSes+AllWindowsOSes+[OS2,EMX, aros]); T:=P.Targets.AddUnit('ssockets.pp',AllUnixOSes+AllWindowsOSes+[OS2,EMX, amiga,aros]);
with T.Dependencies do with T.Dependencies do
begin begin
AddUnit('resolve'); AddUnit('resolve');

99
packages/fcl-net/src/amiga/resolve.inc Normal file
View File

@ -0,0 +1,99 @@
uses
Sysutils;
const
{ Net type }
socklib = 'c';
AF_INET = 2;
{ Error constants. Returned by LastError method of THost, TNet}
NETDB_INTERNAL= -1; { see errno }
NETDB_SUCCESS = 0; { no problem }
HOST_NOT_FOUND= 1; { Authoritative Answer Host not found }
TRY_AGAIN = 2; { Non-Authoritive Host not found, or SERVERFAIL }
NO_RECOVERY = 3; { Non recoverable errors, FORMERR, REFUSED, NOTIMP }
NO_DATA = 4; { Valid name, no data record of requested type }
NO_ADDRESS = NO_DATA; { no address, look for MX record }
Type
{ THostEnt Object }
THostEnt = record
H_Name : pchar; { Official name }
H_Aliases : ppchar; { Null-terminated list of aliases}
H_Addrtype : longint; { Host address type }
H_length : longint; { Length of address }
H_Addr : ppchar; { null-terminated list of adresses }
end;
PHostEntry = ^THostEnt;
{ TNetEnt object }
TNetEnt = record
N_Name : pchar; { Official name }
N_Aliases : ppchar; { Nill-terminated alias list }
N_AddrType : longint; { Net address type }
N_net : Cardinal; { Network number }
end;
PNetEntry = ^TNetEnt;
TServEnt = record
s_name : pchar; { Service name }
s_aliases : ppchar; { Null-terminated alias list }
s_port : longint; { Port number }
s_proto : pchar; { Protocol to use }
end;
PServEntry = ^TServEnt;
{ C style calls, linked in from Libc }
function gethostbyname(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;
function getservbyport(Port: LongInt location 'd0'; Protocol: PChar location 'a0'): PServEntry; syscall SocketBase 240;
procedure setnetent(Stayopen: Longint location 'd0'); syscall SocketBase 516;
procedure endnetent; syscall SocketBase 522;
function getnetent: PNetEntry; syscall SocketBase 528;
procedure setservent(StayOpen: longint location 'd0'); syscall SocketBase 552;
procedure endservent; syscall SocketBase 558;
function getservent: PServEntry; syscall SocketBase 564;
function gethostbyaddr(Addr: PChar; Len: Longint; HType: Longint): PHostentry;
var
addr1,
addr2: in_addr;
IP: PPLongInt;
begin
Addr1 := in_addr(PHostAddr(Addr)^);
Addr2.s_addr := htonl(Addr1.s_addr);
gethostbyaddr := Pointer(bsd_GetHostByAddr(Pointer(@Addr2.s_addr), Len, HType));
if Assigned(gethostbyaddr) then
begin
ip := Pointer(gethostbyaddr^.H_Addr);
if Assigned(ip) then
begin
repeat
ip^^ := ntohl(ip^^);
Inc(IP);
until ip^ = nil;
end;
end;
end;
function GetDNSError: integer;
begin
GetDNSError:=bsd_Errno;
end;
Function InitResolve : Boolean;
begin
Result:=True;
end;
Function FinalResolve : Boolean;
begin
Result:=True;
end;

2
packages/fcl-net/src/ssockets.pp
View File

@ -474,7 +474,7 @@ var
begin begin
{$if defined(unix)} {$if defined(unix)}
fpShutdown(FSocket,SHUT_RDWR); fpShutdown(FSocket,SHUT_RDWR);
{$elseif defined(mswindows) or defined(aros)} {$elseif defined(mswindows) or defined(aros) or defined(amiga)}
CloseSocket(FSocket); CloseSocket(FSocket);
{$else} {$else}
{$WARNING Method Abort is not tested on this platform!} {$WARNING Method Abort is not tested on this platform!}

14
packages/fcl-web/fpmake.pp
View File

@ -17,7 +17,7 @@ begin
P.Directory:=ADirectory; P.Directory:=ADirectory;
{$endif ALLPACKAGES} {$endif ALLPACKAGES}
P.Version:='2.7.1'; P.Version:='2.7.1';
P.OSes := [beos,haiku,freebsd,darwin,iphonesim,solaris,netbsd,openbsd,linux,win32,win64,wince,aix,aros]; P.OSes := [beos,haiku,freebsd,darwin,iphonesim,solaris,netbsd,openbsd,linux,win32,win64,wince,aix,amiga,aros];
P.Dependencies.Add('fcl-base'); P.Dependencies.Add('fcl-base');
P.Dependencies.Add('fcl-db'); P.Dependencies.Add('fcl-db');
P.Dependencies.Add('fcl-xml'); P.Dependencies.Add('fcl-xml');
@ -25,8 +25,8 @@ begin
P.Dependencies.Add('fcl-net'); P.Dependencies.Add('fcl-net');
P.Dependencies.Add('fcl-process'); P.Dependencies.Add('fcl-process');
P.Dependencies.Add('fastcgi'); P.Dependencies.Add('fastcgi');
P.Dependencies.Add('httpd22', AllOses - [aros]); P.Dependencies.Add('httpd22', AllOses - [amiga,aros]);
P.Dependencies.Add('httpd24', AllOses - [aros]); P.Dependencies.Add('httpd24', AllOses - [amiga,aros]);
// (Temporary) indirect dependencies, not detected by fpcmake: // (Temporary) indirect dependencies, not detected by fpcmake:
P.Dependencies.Add('univint',[MacOSX,iphonesim]); P.Dependencies.Add('univint',[MacOSX,iphonesim]);
@ -115,26 +115,26 @@ begin
end; end;
with P.Targets.AddUnit('fpfcgi.pp') do with P.Targets.AddUnit('fpfcgi.pp') do
begin begin
OSes:=AllOses-[wince,darwin,iphonesim,aix,aros]; OSes:=AllOses-[wince,darwin,iphonesim,aix,amiga,aros];
Dependencies.AddUnit('custfcgi'); Dependencies.AddUnit('custfcgi');
end; end;
with P.Targets.AddUnit('custfcgi.pp') do with P.Targets.AddUnit('custfcgi.pp') do
begin begin
OSes:=AllOses-[wince,darwin,iphonesim,aix,aros]; OSes:=AllOses-[wince,darwin,iphonesim,aix,amiga,aros];
Dependencies.AddUnit('httpdefs'); Dependencies.AddUnit('httpdefs');
Dependencies.AddUnit('custweb'); Dependencies.AddUnit('custweb');
ResourceStrings:=true; ResourceStrings:=true;
end; end;
with P.Targets.AddUnit('fpapache.pp') do with P.Targets.AddUnit('fpapache.pp') do
begin begin
OSes:=AllOses-[aros]; OSes:=AllOses-[amiga,aros];
Dependencies.AddUnit('fphttp'); Dependencies.AddUnit('fphttp');
Dependencies.AddUnit('custweb'); Dependencies.AddUnit('custweb');
ResourceStrings:=true; ResourceStrings:=true;
end; end;
with P.Targets.AddUnit('fpapache24.pp') do with P.Targets.AddUnit('fpapache24.pp') do
begin begin
OSes:=AllOses-[aros]; OSes:=AllOses-[amiga,aros];
Dependencies.AddUnit('fphttp'); Dependencies.AddUnit('fphttp');
Dependencies.AddUnit('custweb'); Dependencies.AddUnit('custweb');
ResourceStrings:=true; ResourceStrings:=true;

4
packages/fcl-web/src/base/fphttpclient.pp
View File

@ -275,7 +275,7 @@ Function EncodeURLElement(S : String) : String;
Function DecodeURLElement(Const S : String) : String; Function DecodeURLElement(Const S : String) : String;
implementation implementation
{$ifndef AROS} {$if not defined(aros) and not defined(amiga)}
uses sslsockets; uses sslsockets;
{$endif} {$endif}
@ -427,7 +427,7 @@ begin
if Assigned(FonGetSocketHandler) then if Assigned(FonGetSocketHandler) then
FOnGetSocketHandler(Self,UseSSL,Result); FOnGetSocketHandler(Self,UseSSL,Result);
if (Result=Nil) then if (Result=Nil) then
{$ifndef AROS} {$if not defined(AROS) and not defined(Amiga)}
If UseSSL then If UseSSL then
Result:=TSSLSocketHandler.Create Result:=TSSLSocketHandler.Create
else else

3
packages/rtl-extra/fpmake.pp
View File

@ -28,7 +28,7 @@ Const
WinsockOSes = [win32,win64,wince,os2,emx,netware,netwlibc]; WinsockOSes = [win32,win64,wince,os2,emx,netware,netwlibc];
WinSock2OSes = [win32,win64,wince]; WinSock2OSes = [win32,win64,wince];
// sockets of morphos is implemented, but not active // sockets of morphos is implemented, but not active
SocketsOSes = UnixLikes+[aros,netware,netwlibc,os2,wince,win32,win64]; SocketsOSes = UnixLikes+[amiga,aros,netware,netwlibc,os2,wince,win32,win64];
Socksyscall = [beos,freebsd,haiku,linux,netbsd,openbsd]; Socksyscall = [beos,freebsd,haiku,linux,netbsd,openbsd];
Socklibc = unixlikes-socksyscall; Socklibc = unixlikes-socksyscall;
gpmOSes = [Linux,Android]; gpmOSes = [Linux,Android];
@ -54,6 +54,7 @@ begin
P.NeedLibC:= false; P.NeedLibC:= false;
P.Dependencies.Add('morphunits',[morphos]); P.Dependencies.Add('morphunits',[morphos]);
P.Dependencies.Add('arosunits',[aros]); P.Dependencies.Add('arosunits',[aros]);
P.Dependencies.Add('amunits',[amiga]);
P.SourcePath.Add('src/inc'); P.SourcePath.Add('src/inc');
P.SourcePath.Add('src/$(OS)'); P.SourcePath.Add('src/$(OS)');

271
packages/rtl-extra/src/amiga/sockets.pp Normal file
View File

@ -0,0 +1,271 @@
{
This file is part of the Free Pascal run time library.
Copyright (c) 1999-2007 by the Free Pascal development team
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.
**********************************************************************}
{$PACKRECORDS 2}
unit Sockets;
Interface
uses
ctypes,exec;
type
size_t = cuint32; { as definied in the C standard}
ssize_t = cint32; { used by function for returning number of bytes}
socklen_t= cuint32;
TSocklen = socklen_t;
pSocklen = ^socklen_t;
//{ $i unxsockh.inc}
{$define BSD}
{$define SOCK_HAS_SINLEN}
{$i socketsh.inc}
type
TUnixSockAddr = packed Record
sa_len : cuchar;
family : sa_family_t;
path:array[0..107] of char; //104 total for freebsd.
end;
type
hostent = record
h_name : PChar;
h_aliases : PPChar;
h_addrtype : LongInt;
h_Length : LongInt;
h_addr_list: ^PDWord;
end;
THostEnt = hostent;
PHostEnt = ^THostEnt;
const
AF_UNSPEC = 0; {* unspecified *}
AF_LOCAL = 1; {* local to host (pipes, portals) *}
AF_UNIX = AF_LOCAL; {* backward compatibility *}
AF_INET = 2; {* internetwork: UDP, TCP, etc. *}
AF_IMPLINK = 3; {* arpanet imp addresses *}
AF_PUP = 4; {* pup protocols: e.g. BSP *}
AF_CHAOS = 5; {* mit CHAOS protocols *}
AF_NS = 6; {* XEROX NS protocols *}
AF_ISO = 7; {* ISO protocols *}
AF_OSI = AF_ISO;
AF_ECMA = 8; {* european computer manufacturers *}
AF_DATAKIT = 9; {* datakit protocols *}
AF_CCITT = 10; {* CCITT protocols, X.25 etc *}
AF_SNA = 11; {* IBM SNA *}
AF_DECnet = 12; {* DECnet *}
AF_DLI = 13; {* DEC Direct data link interface *}
AF_LAT = 14; {* LAT *}
AF_HYLINK = 15; {* NSC Hyperchannel *}
AF_APPLETALK = 16; {* Apple Talk *}
AF_ROUTE = 17; {* Internal Routing Protocol *}
AF_LINK = 18; {* Link layer interface *}
pseudo_AF_XTP = 19; {* eXpress Transfer Protocol (no AF) *}
AF_COIP = 20; {* connection-oriented IP, aka ST II *}
AF_CNT = 21; {* Computer Network Technology *}
pseudo_AF_RTIP = 22; {* Help Identify RTIP packets *}
AF_IPX = 23; {* Novell Internet Protocol *}
AF_SIP = 24; {* Simple Internet Protocol *}
pseudo_AF_PIP = 25; {* Help Identify PIP packets *}
AF_MAX = 26;
SO_LINGER = $0080;
SOL_SOCKET = $FFFF;
const
EsockEINTR = 4; // EsysEINTR;
EsockEBADF = 9; // EsysEBADF;
EsockEFAULT = 14; // EsysEFAULT;
EsockEINVAL = 22; //EsysEINVAL;
EsockEACCESS = 13; //ESysEAcces;
EsockEMFILE = 24; //ESysEmfile;
EsockENOBUFS = 55; //ESysENoBufs;
EsockENOTCONN = 57; //ESysENotConn;
EsockEPROTONOSUPPORT = 43; //ESysEProtoNoSupport;
EsockEWOULDBLOCK = 35; //ESysEWouldBlock; // same as eagain on morphos
{ unix socket specific functions }
{*
Procedure Str2UnixSockAddr(const addr:string;var t:TUnixSockAddr;var len:longint); deprecated;
Function Bind(Sock:longint;const addr:string):boolean; deprecated;
Function Connect(Sock:longint;const addr:string;var SockIn,SockOut:text):Boolean; deprecated;
Function Connect(Sock:longint;const addr:string;var SockIn,SockOut:file):Boolean; deprecated;
Function Accept(Sock:longint;var addr:string;var SockIn,SockOut:text):Boolean; deprecated;
Function Accept(Sock:longint;var addr:string;var SockIn,SockOut:File):Boolean; deprecated;
*}
//function fpaccept (s:cint; addrx : psockaddr; addrlen : psocklen):cint; maybelibc
//function fpbind (s:cint; addrx : psockaddr; addrlen : tsocklen):cint; maybelibc
//function fpconnect (s:cint; name : psockaddr; namelen : tsocklen):cint; maybelibc
var
SocketBase: PLibrary;
function bsd_socket(Domain: LongInt location 'd0'; Type_: LongInt location 'd1'; Protocol: LongInt location 'd2'): LongInt; syscall SocketBase 30;
function bsd_bind(s: LongInt location 'd0'; const name: PSockAddr location 'a0'; NameLen: LongInt location 'd1'): LongInt; syscall SocketBase 36;
function bsd_listen(s: LongInt location 'd0'; BackLog: LongInt location 'd1'): LongInt; syscall SocketBase 42;
function bsd_accept(s: LongInt location 'd0'; Addr: PSockaddr location 'a0'; AddrLen: PSockLen location 'a1'): LongInt; syscall SocketBase 48;
function bsd_connect(s : LongInt location 'd0'; const Name: PSockaddr location 'a0'; NameLen: LongInt location 'd1'): LongInt; syscall SocketBase 54;
function bsd_sendto(s: LongInt location 'd0'; const Msg: PChar location 'a0'; Len: LongInt location 'd1'; Flags: LongInt location 'd2'; const To_: PSockaddr location 'a1'; ToLen: LongInt location 'd3'): LongInt; syscall SocketBase 60;
function bsd_send(s: LongInt location 'd0'; const msg: PChar location 'a0'; Len: LongInt location 'd1'; Flags: LongInt location 'd2'): LongInt; syscall SocketBase 66;
function bsd_recvfrom(s: LongInt location 'd0'; Buf: PChar location 'a0'; Len: LongInt location 'd1'; Flags: LongInt location 'd2'; From: PSockaddr location 'a1'; FromLen: PSockLen location 'a2'): LongInt; syscall SocketBase 72;
function bsd_recv(s: LongInt location 'd0'; buf: PChar location 'a0'; Len: LongInt location 'd1'; Flags: LongInt location 'd2'): LongInt; syscall SocketBase 78;
function bsd_shutdown(s: LongInt location 'd0'; How: LongInt location 'd1'): LongInt; syscall SocketBase 84;
function bsd_setsockopt(s: LongInt location 'd0'; level: LongInt location 'd1'; optname: LongInt location 'd2'; const optval: Pointer location 'a0'; optlen: LongInt location 'd3') : LongInt; syscall SocketBase 90;
function bsd_getsockopt(s: LongInt location 'd0'; Level: LongInt location 'd1'; OptName: LongInt location 'd2'; OptVal: Pointer location 'a0'; OptLen: PSockLen location 'a1'): LongInt; syscall SocketBase 96;
function bsd_getsockname(s: LongInt location 'd0'; HostName: PSockaddr location 'a0'; NameLen: PSockLen location 'a1'): LongInt; syscall SocketBase 102;
function bsd_getpeername(s: LongInt location 'd0'; HostName: PSockaddr location 'a0'; NameLen: PSockLen location 'a1'): LongInt; syscall SocketBase 108;
function bsd_closesocket(s: LongInt location 'd0'): LongInt; syscall SocketBase 120;
function bsd_Errno: LongInt; syscall SocketBase 162;
function bsd_inet_ntoa(in_: LongWord location 'd0'): PChar; syscall SocketBase 174;
function bsd_inet_addr(const cp: PChar location 'a0'): LongWord; syscall SocketBase 180;
function bsd_gethostbyname(const Name: PChar location 'a0'): PHostEnt; syscall SocketBase 210;
function bsd_gethostbyaddr(const Addr: PByte location 'a0'; Len: LongInt location 'd0'; Type_: LongInt location 'd1'): PHostEnt; syscall SocketBase 216;
Implementation
threadvar internal_socketerror: cint;
{ Include filerec and textrec structures }
{.$i filerec.inc}
{.$i textrec.inc}
{******************************************************************************
Kernel Socket Callings
******************************************************************************}
function socketerror: cint;
begin
socketerror := internal_socketerror;
end;
function fpgeterrno: longint; inline;
begin
fpgeterrno := bsd_Errno;
end;
function fpClose(d: LongInt): LongInt; inline;
begin
fpClose := bsd_CloseSocket(d);
end;
function fpaccept(s: cint; addrx: PSockaddr; Addrlen: PSocklen): cint;
begin
fpaccept := bsd_accept(s,addrx,addrlen);
internal_socketerror := fpgeterrno;
end;
function fpbind(s:cint; addrx: psockaddr; addrlen: tsocklen): cint;
begin
fpbind := bsd_bind(s, addrx, addrlen);
internal_socketerror := fpgeterrno;
end;
function fpconnect(s:cint; name: psockaddr; namelen: tsocklen): cint;
begin
fpconnect := bsd_connect(s, name, namelen);
internal_socketerror := fpgeterrno;
end;
function fpgetpeername (s:cint; name : psockaddr; namelen : psocklen):cint;
begin
fpgetpeername := bsd_getpeername(s,name,namelen);
internal_socketerror := fpgeterrno;
end;
function fpgetsockname(s:cint; name : psockaddr; namelen : psocklen):cint;
begin
fpgetsockname := bsd_getsockname(s,name,namelen);
internal_socketerror := fpgeterrno;
end;
function fpgetsockopt (s:cint; level:cint; optname:cint; optval:pointer; optlen : psocklen):cint;
begin
fpgetsockopt := bsd_getsockopt(s,level,optname,optval,optlen);
internal_socketerror := fpgeterrno;
end;
function fplisten(s:cint; backlog : cint):cint;
begin
fplisten := bsd_listen(s, backlog);
internal_socketerror := fpgeterrno;
end;
function fprecv(s:cint; buf: pointer; len: size_t; Flags: cint): ssize_t;
begin
fprecv := bsd_recv(s,buf,len,flags);
internal_socketerror := fpgeterrno;
end;
function fprecvfrom(s:cint; buf: pointer; len: size_t; flags: cint; from : psockaddr; fromlen : psocklen):ssize_t;
begin
fprecvfrom := bsd_recvfrom(s, buf, len, flags, from, fromlen);
internal_socketerror := fpgeterrno;
end;
function fpsend(s:cint; msg:pointer; len:size_t; flags:cint):ssize_t;
begin
fpsend := bsd_send(s, msg, len, flags);
internal_socketerror := fpgeterrno;
end;
function fpsendto(s:cint; msg:pointer; len:size_t; flags:cint; tox :psockaddr; tolen: tsocklen):ssize_t;
begin
fpsendto := bsd_sendto(s, msg, len, flags, tox, tolen);
internal_socketerror := fpgeterrno;
end;
function fpsetsockopt(s:cint; level:cint; optname:cint; optval:pointer; optlen :tsocklen):cint;
begin
fpsetsockopt := bsd_setsockopt(s, level, optname, optval, optlen);
internal_socketerror := fpgeterrno;
end;
function fpshutdown(s: cint; how: cint): cint;
begin
fpshutdown := bsd_shutdown(s, how);
internal_socketerror := fpgeterrno;
end;
function fpsocket(domain: cint; xtype: cint; protocol: cint): cint;
begin
fpsocket := bsd_socket(domain, xtype, protocol);
internal_socketerror := fpgeterrno;
end;
function fpsocketpair(d:cint; xtype:cint; protocol:cint; sv:pcint):cint;
begin
{
fpsocketpair:=cfpsocketpair(d,xtype,protocol,sv);
internal_socketerror:=fpgeterrno;
}
fpsocketpair:=-1;
end;
{$i sockovl.inc}
{$i sockets.inc}
// FIXME: this doesn't make any sense here, because SocketBase should be task-specific
// but FPC doesn't support that yet (TODO)
{$WARNING FIX ME, TODO}
initialization
SocketBase := OpenLibrary('bsdsocket.library',0);
finalization
if SocketBase <> nil then
CloseLibrary(SocketBase);
end.

22
tests/webtbs/tw26627.pp
View File

@ -1,16 +1,16 @@
program test; program test;
{$mode objfpc}{$h+} {$mode objfpc}{$h+}
uses SysUtils; uses SysUtils;
var a: ansistring; var a: ansistring;
begin begin
defaultfilesystemcodepage:=CP_UTF8; defaultfilesystemcodepage:=CP_UTF8;
defaultrtlfilesystemcodepage:=CP_ASCII; defaultrtlfilesystemcodepage:=CP_ASCII;
a := DirectorySeparator+'.'; a := DirectorySeparator+'.';
a := ExpandFileName(a); a := ExpandFileName(a);
if StringCodePage(a)<> defaultrtlfilesystemcodepage then if StringCodePage(a)<> defaultrtlfilesystemcodepage then
halt(1); halt(1);
end. end.