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

+ Restore and fix text/file socket functionality.

Browse Source 
git-svn-id: trunk@5973 -
This commit is contained in:
daniel 2007-01-14 18:50:19 +00:00
parent 5e2042cff8
commit 1c452dd4f9
6 changed files with 435 additions and 0 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

200
rtl/inc/sockets.inc
View File

@ -11,6 +11,206 @@
**********************************************************************}
{******************************************************************************
Text File Writeln/ReadLn Support
******************************************************************************}
Procedure OpenSock(var F:Text);
begin
if textrec(f).handle=UnusedHandle then
textrec(f).mode:=fmclosed
else
case textrec(f).userdata[1] of
S_OUT : textrec(f).mode:=fmoutput;
S_IN : textrec(f).mode:=fminput;
else
textrec(f).mode:=fmclosed;
end;
end;
procedure iosock(var f:text);
var r:sizeint;
def_error:word;
begin
with textrec(f) do
begin
case mode of
fmoutput:
begin
repeat
{$ifdef use_readwrite}
r:=fpwrite(handle,bufptr^,bufpos);
{$else}
r:=send(handle,bufptr^,bufpos,0);
{$endif}
until (r<>-1) or (errno<>EsysEINTR);
bufend:=r;
def_error:=101; {File write error.}
end;
fminput:
begin
repeat
{$ifdef use_readwrite}
r:=fpread(handle,bufptr^,bufsize);
{$else}
r:=recv(handle,bufptr^,bufsize,0);
{$endif}
until (r<>-1) or (errno<>EsysEINTR);
bufend:=r;
def_error:=100; {File read error.}
end;
end;
if r=-1 then
case errno of
EsysEBADF:
{ EsysENOTSOCK:} {Why is this constant not defined? (DM)}
inoutres:=6; {Invalid file handle.}
EsysEFAULT:
inoutres:=217;
EsysEINVAL:
inoutres:=218;
else
inoutres:=def_error;
end;
bufpos:=0;
end;
end;
Procedure FlushSock(var F:Text);
begin
if (textrec(f).mode=fmoutput) and (textrec(f).bufpos<>0) then
begin
IOSock(f);
textrec(f).bufpos:=0;
end;
end;
Procedure CloseSock(var F:text);
begin
{ Nothing special has to be done here }
end;
Procedure Sock2Text(Sock:Longint;Var SockIn,SockOut:Text);
{
Set up two Pascal Text file descriptors for reading and writing)
}
begin
{ First the reading part.}
Assign(SockIn,'.');
Textrec(SockIn).Handle:=Sock;
Textrec(Sockin).userdata[1]:=S_IN;
TextRec(SockIn).OpenFunc:=@OpenSock;
TextRec(SockIn).InOutFunc:=@IOSock;
TextRec(SockIn).FlushFunc:=@FlushSock;
TextRec(SockIn).CloseFunc:=@CloseSock;
TextRec(SockIn).Mode := fmInput;
{ Now the writing part. }
Assign(SockOut,'.');
Textrec(SockOut).Handle:=Sock;
Textrec(SockOut).userdata[1]:=S_OUT;
TextRec(SockOut).OpenFunc:=@OpenSock;
TextRec(SockOut).InOutFunc:=@IOSock;
TextRec(SockOut).FlushFunc:=@FlushSock;
TextRec(SockOut).CloseFunc:=@CloseSock;
TextRec(SockOut).Mode := fmOutput;
end;
{******************************************************************************
Untyped File
******************************************************************************}
Procedure Sock2File(Sock:Longint;Var SockIn,SockOut:File);
begin
{Input}
Assign(SockIn,'.');
FileRec(SockIn).Handle:=Sock;
FileRec(SockIn).RecSize:=1;
FileRec(Sockin).userdata[1]:=S_IN;
FileRec(SockIn).Mode := fmInput;
{Output}
Assign(SockOut,'.');
FileRec(SockOut).Handle:=Sock;
FileRec(SockOut).RecSize:=1;
FileRec(SockOut).userdata[1]:=S_OUT;
FileRec(SockOut).Mode := fmOutput;
end;
{******************************************************************************
InetSock
******************************************************************************}
Function DoAccept(Sock:longint;Var addr:TInetSockAddr):longint;
Var AddrLen : Longint;
begin
AddrLEn:=SizeOf(Addr);
DoAccept:=Accept(Sock,Addr,AddrLen);
end;
Function DoConnect(Sock:longint;const addr: TInetSockAddr): Boolean;
begin
DoConnect:=Connect(Sock,Addr,SizeOF(TInetSockAddr));
end;
Function Connect(Sock:longint;const addr: TInetSockAddr;var SockIn,SockOut:text):Boolean;
begin
Connect:=DoConnect(Sock,addr);
If Connect then
Sock2Text(Sock,SockIn,SockOut);
end;
Function Connect(Sock:longint;const addr:TInetSockAddr;var SockIn,SockOut:file):Boolean;
begin
Connect:=DoConnect(Sock,addr);
If Connect then
Sock2File(Sock,SockIn,SockOut);
end;
Function Accept(Sock:longint;var addr:TInetSockAddr;var SockIn,SockOut:text):Boolean;
var
s : longint;
begin
S:=DoAccept(Sock,addr);
if S>0 then
begin
Sock2Text(S,SockIn,SockOut);
Accept:=true;
end
else
Accept:=false;
end;
Function Accept(Sock:longint;var addr:TInetSockAddr;var SockIn,SockOut:File):Boolean;
var
s : longint;
begin
S:=DoAccept(Sock,addr);
if S>0 then
begin
Sock2File(S,SockIn,SockOut);
Accept:=true;
end
else
Accept:=false;
end;
type thostaddr= packed array[1..4] of byte;
function htonl( host : longint):longint; inline;

13
rtl/inc/socketsh.inc
View File

@ -191,6 +191,19 @@ Function SetSocketOptions(Sock,Level,OptName:Longint;const OptVal;optlen:longint
Function GetSocketOptions(Sock,Level,OptName:Longint;Var OptVal;Var optlen:longint):Longint;
Function SocketPair(Domain,SocketType,Protocol:Longint;var Pair:TSockArray):Longint;
{Text Support}
Procedure Sock2Text(Sock:Longint;Var SockIn,SockOut:Text);
{Untyped File Support}
Procedure Sock2File(Sock:Longint;Var SockIn,SockOut:File);
{Better Pascal Calling, Overloaded Functions!}
Function Accept(Sock:longint;var addr:TInetSockAddr;var SockIn,SockOut:File):Boolean;
Function Accept(Sock:longint;var addr:TInetSockAddr;var SockIn,SockOut:text):Boolean;
Function Connect(Sock:longint;const addr:TInetSockAddr;var SockIn,SockOut:text):Boolean;
Function Connect(Sock:longint;const addr:TInetSockAddr;var SockIn,SockOut:file):Boolean;
{ Utility routines}
function htonl( host : longint):longint; inline;
Function NToHl( Net : Longint) : Longint; inline;

73
rtl/inc/sockovl.inc
View File

@ -119,6 +119,79 @@ begin
Bind:=(SocketError=0);
end;
Function DoAccept(Sock:longint;var addr:string):longint;
var
UnixAddr : TUnixSockAddr;
AddrLen : longint;
begin
AddrLen:=length(addr)+3;
DoAccept:=Accept(Sock,UnixAddr,AddrLen);
Move(UnixAddr.Path,Addr[1],AddrLen);
SetLength(Addr,AddrLen);
end;
Function DoConnect(Sock:longint;const addr:string):Boolean;
var
UnixAddr : TUnixSockAddr;
AddrLen : longint;
begin
Str2UnixSockAddr(addr,UnixAddr,AddrLen);
DoConnect:=Connect(Sock,UnixAddr,AddrLen);
end;
Function Accept(Sock:longint;var addr:string;var SockIn,SockOut:text):Boolean;
var
s : longint;
begin
S:=DoAccept(Sock,addr);
if S>0 then
begin
Sock2Text(S,SockIn,SockOut);
Accept:=true;
end
else
Accept:=false;
end;
Function Accept(Sock:longint;var addr:string;var SockIn,SockOut:File):Boolean;
var
s : longint;
begin
S:=DoAccept(Sock,addr);
if S>0 then
begin
Sock2File(S,SockIn,SockOut);
Accept:=true;
end
else
Accept:=false;
end;
Function Connect(Sock:longint;const addr:string;var SockIn,SockOut:text):Boolean;
begin
Connect:=DoConnect(Sock,addr);
If Connect then
Sock2Text(Sock,SockIn,SockOut);
end;
Function Connect(Sock:longint;const addr:string;var SockIn,SockOut:file):Boolean;
begin
Connect:=DoConnect(Sock,addr);
if Connect then
Sock2File(Sock,SockIn,SockOut);
end;
Function CloseSocket (Sock:Longint):Longint;
begin
if fpclose(Sock)=0 then

73
rtl/netware/nwsock.inc
View File

@ -140,6 +140,79 @@ begin
Bind:=(SocketError=0);
end;
Function DoAccept(Sock:longint;var addr:string):longint;
var
UnixAddr : TUnixSockAddr;
AddrLen : longint;
begin
AddrLen:=length(addr)+3;
DoAccept:=Accept(Sock,UnixAddr,AddrLen);
Move(UnixAddr.Path,Addr[1],AddrLen);
SetLength(Addr,AddrLen);
end;
Function DoConnect(Sock:longint;const addr:string):Boolean;
var
UnixAddr : TUnixSockAddr;
AddrLen : longint;
begin
Str2UnixSockAddr(addr,UnixAddr,AddrLen);
DoConnect:=Connect(Sock,UnixAddr,AddrLen);
end;
Function Accept(Sock:longint;var addr:string;var SockIn,SockOut:text):Boolean;
var
s : longint;
begin
S:=DoAccept(Sock,addr);
if S>0 then
begin
Sock2Text(S,SockIn,SockOut);
Accept:=true;
end
else
Accept:=false;
end;
Function Accept(Sock:longint;var addr:string;var SockIn,SockOut:File):Boolean;
var
s : longint;
begin
S:=DoAccept(Sock,addr);
if S>0 then
begin
Sock2File(S,SockIn,SockOut);
Accept:=true;
end
else
Accept:=false;
end;
Function Connect(Sock:longint;const addr:string;var SockIn,SockOut:text):Boolean;
begin
Connect:=DoConnect(Sock,addr);
If Connect then
Sock2Text(Sock,SockIn,SockOut);
end;
Function Connect(Sock:longint;const addr:string;var SockIn,SockOut:file):Boolean;
begin
Connect:=DoConnect(Sock,addr);
if Connect then
Sock2File(Sock,SockIn,SockOut);
end;
// fsread and fswrite are used in socket.inc
procedure fdwrite (Handle:longint; VAR Data; Len : LONGINT);
begin

72
rtl/openbsd/unixsock.inc
View File

@ -137,3 +137,75 @@ begin
Bind:=(SocketError=0);
end;
Function DoAccept(Sock:longint;var addr:string):longint;
var
UnixAddr : TUnixSockAddr;
AddrLen : longint;
begin
AddrLen:=length(addr)+3;
DoAccept:=Accept(Sock,UnixAddr,AddrLen);
Move(UnixAddr.Path,Addr[1],AddrLen);
SetLength(Addr,AddrLen);
end;
Function DoConnect(Sock:longint;const addr:string):Boolean;
var
UnixAddr : TUnixSockAddr;
AddrLen : longint;
begin
Str2UnixSockAddr(addr,UnixAddr,AddrLen);
DoConnect:=Connect(Sock,UnixAddr,AddrLen);
end;
Function Accept(Sock:longint;var addr:string;var SockIn,SockOut:text):Boolean;
var
s : longint;
begin
S:=DoAccept(Sock,addr);
if S>0 then
begin
Sock2Text(S,SockIn,SockOut);
Accept:=true;
end
else
Accept:=false;
end;
Function Accept(Sock:longint;var addr:string;var SockIn,SockOut:File):Boolean;
var
s : longint;
begin
S:=DoAccept(Sock,addr);
if S>0 then
begin
Sock2File(S,SockIn,SockOut);
Accept:=true;
end
else
Accept:=false;
end;
Function Connect(Sock:longint;const addr:string;var SockIn,SockOut:text):Boolean;
begin
Connect:=DoConnect(Sock,addr);
If Connect then
Sock2Text(Sock,SockIn,SockOut);
end;
Function Connect(Sock:longint;const addr:string;var SockIn,SockOut:file):Boolean;
begin
Connect:=DoConnect(Sock,addr);
if Connect then
Sock2File(Sock,SockIn,SockOut);
end;

4
rtl/unix/sockets.pp
View File

@ -41,6 +41,10 @@ type
{ unix socket specific functions }
Procedure Str2UnixSockAddr(const addr:string;var t:TUnixSockAddr;var len:longint);
Function Bind(Sock:longint;const addr:string):boolean;
Function Connect(Sock:longint;const addr:string;var SockIn,SockOut:text):Boolean;
Function Connect(Sock:longint;const addr:string;var SockIn,SockOut:file):Boolean;
Function Accept(Sock:longint;var addr:string;var SockIn,SockOut:text):Boolean;
Function Accept(Sock:longint;var addr:string;var SockIn,SockOut:File):Boolean;
//function fpaccept (s:cint; addrx : psockaddr; addrlen : psocklen):cint; maybelibc
//function fpbind (s:cint; addrx : psockaddr; addrlen : tsocklen):cint; maybelibc