From 1c452dd4f98e0aba44d7b35e89730b20e1505033 Mon Sep 17 00:00:00 2001
From: daniel <daniel@freepascal.org>
Date: Sun, 14 Jan 2007 18:50:19 +0000
Subject: [PATCH] + Restore and fix text/file socket functionality.
git-svn-id: trunk@5973 -
---
rtl/inc/sockets.inc | 200 +++++++++++++++++++++++++++++++++++++++
rtl/inc/socketsh.inc | 13 +++
rtl/inc/sockovl.inc | 73 ++++++++++++++
rtl/netware/nwsock.inc | 73 ++++++++++++++
rtl/openbsd/unixsock.inc | 72 ++++++++++++++
rtl/unix/sockets.pp | 4 +
6 files changed, 435 insertions(+)
diff --git a/rtl/inc/sockets.inc b/rtl/inc/sockets.inc
index 758a42c574..edb6acf27e 100644
--- a/rtl/inc/sockets.inc
+++ b/rtl/inc/sockets.inc
@@ -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;
diff --git a/rtl/inc/socketsh.inc b/rtl/inc/socketsh.inc
index 726d23653a..eefadb0378 100644
--- a/rtl/inc/socketsh.inc
+++ b/rtl/inc/socketsh.inc
@@ -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;
diff --git a/rtl/inc/sockovl.inc b/rtl/inc/sockovl.inc
index 941b6a0051..393b1cdda7 100644
--- a/rtl/inc/sockovl.inc
+++ b/rtl/inc/sockovl.inc
@@ -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
diff --git a/rtl/netware/nwsock.inc b/rtl/netware/nwsock.inc
index fe8f3b524e..8e2962af70 100644
--- a/rtl/netware/nwsock.inc
+++ b/rtl/netware/nwsock.inc
@@ -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
diff --git a/rtl/openbsd/unixsock.inc b/rtl/openbsd/unixsock.inc
index ef54bf8e83..aead21ae2b 100644
--- a/rtl/openbsd/unixsock.inc
+++ b/rtl/openbsd/unixsock.inc
@@ -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;
+
diff --git a/rtl/unix/sockets.pp b/rtl/unix/sockets.pp
index 9c936e7d97..1a36f2696e 100644
--- a/rtl/unix/sockets.pp
+++ b/rtl/unix/sockets.pp
@@ -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