mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-06-03 17:18:34 +02:00
400 lines
8.9 KiB
PHP
400 lines
8.9 KiB
PHP
{
|
|
This file is part of the Free Pascal run time library.
|
|
Copyright (c) 1999-2000 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.
|
|
|
|
**********************************************************************}
|
|
|
|
{******************************************************************************
|
|
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);
|
|
begin
|
|
case textrec(f).mode of
|
|
fmoutput : {$ifdef unix}fpWrite{$else}fdwrite{$endif}(textrec(f).handle,textrec(f).bufptr^,textrec(f).bufpos);
|
|
fminput : textrec(f).BufEnd:={$ifdef Unix}fpRead{$else}fdread{$endif}(textrec(f).handle,textrec(f).bufptr^,textrec(f).bufsize);
|
|
end;
|
|
textrec(f).bufpos:=0;
|
|
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; {$ifdef HASINLINE} inline; {$ENDIF}
|
|
|
|
begin
|
|
{$ifdef FPC_BIG_ENDIAN}
|
|
htonl:=host;
|
|
{$else}
|
|
htonl:=THostAddr(host)[4];
|
|
htonl:=htonl or ( (THostAddr(host)[3]) shl 8);
|
|
htonl:=htonl or ( (THostAddr(host)[2]) shl 16);
|
|
htonl:=htonl or ( (THostAddr(host)[1]) shl 24);
|
|
{$endif}
|
|
end;
|
|
|
|
Function NToHl (Net : Longint) : Longint; {$ifdef HASINLINE} inline; {$ENDIF}
|
|
|
|
begin
|
|
{$ifdef FPC_BIG_ENDIAN}
|
|
ntohl:=net;
|
|
{$else}
|
|
ntohl:=THostAddr(Net)[4];
|
|
ntohl:=ntohl or ( (THostAddr(Net)[3]) shl 8);
|
|
ntohl:=ntohl or ( (THostAddr(Net)[2]) shl 16);
|
|
ntohl:=ntohl or ( (THostAddr(Net)[1]) shl 24);
|
|
{$endif}
|
|
end;
|
|
|
|
function htons( host : word):word; {$ifdef HASINLINE} inline; {$ENDIF}
|
|
|
|
begin
|
|
{$ifdef FPC_BIG_ENDIAN}
|
|
htons:=host;
|
|
{$else}
|
|
htons:=swap(host);
|
|
{$endif}
|
|
end;
|
|
|
|
Function NToHs (Net : word):word;{$ifdef HASINLINE} inline; {$ENDIF}
|
|
|
|
begin
|
|
{$ifdef FPC_BIG_ENDIAN}
|
|
ntohs:=net;
|
|
{$else}
|
|
ntohs:=swap(net);
|
|
{$endif}
|
|
end;
|
|
|
|
Type array4int = array[1..4] of byte;
|
|
|
|
function NetAddrToStr (Entry : in_addr) : AnsiString;
|
|
|
|
Var Dummy : Ansistring;
|
|
i,j : Longint;
|
|
|
|
begin
|
|
NetAddrToStr:='';
|
|
j:=entry.s_addr;
|
|
For I:=1 to 4 do
|
|
begin
|
|
Str(array4int(j)[i],Dummy);
|
|
NetAddrToStr:=NetAddrToStr+Dummy;
|
|
If I<4 Then
|
|
NetAddrToStr:=NetAddrToStr+'.';
|
|
end;
|
|
end;
|
|
|
|
function HostAddrToStr (Entry : in_addr) : AnsiString;
|
|
|
|
Var x: in_addr;
|
|
|
|
begin
|
|
x.s_addr:=htonl(entry.s_addr);
|
|
HostAddrToStr:=NetAddrToStr(x);
|
|
end;
|
|
|
|
function StrToHostAddr(IP : AnsiString) : in_addr ;
|
|
|
|
Var
|
|
Dummy : AnsiString;
|
|
I,j,k : Longint;
|
|
Temp : in_addr;
|
|
|
|
begin
|
|
strtohostaddr.s_addr:=0; //:=NoAddress;
|
|
For I:=1 to 4 do
|
|
begin
|
|
If I<4 Then
|
|
begin
|
|
J:=Pos('.',IP);
|
|
If J=0 then
|
|
exit;
|
|
Dummy:=Copy(IP,1,J-1);
|
|
Delete (IP,1,J);
|
|
end
|
|
else
|
|
Dummy:=IP;
|
|
Val (Dummy,k,J);
|
|
array4int(temp.s_addr)[i]:=k;
|
|
If J<>0 then Exit;
|
|
end;
|
|
strtohostaddr.s_addr:=ntohl(Temp.s_addr);
|
|
end;
|
|
|
|
function StrToNetAddr(IP : AnsiString) : in_addr;
|
|
|
|
begin
|
|
StrToNetAddr.s_addr:=htonl(StrToHostAddr(IP).s_addr);
|
|
end;
|
|
|
|
Function HostToNet (Host : in_addr):in_addr;
|
|
|
|
begin
|
|
HostToNet.s_addr:=htonl(host.s_addr);
|
|
end;
|
|
|
|
Function NetToHost (Net : in_addr) : in_addr;
|
|
|
|
begin
|
|
NetToHost.s_addr:=ntohl(net.s_addr);
|
|
end;
|
|
|
|
Function HostToNet (Host : Longint) : Longint;
|
|
|
|
begin
|
|
HostToNet:=htonl(host);
|
|
end;
|
|
|
|
Function NetToHost (Net : Longint) : Longint;
|
|
|
|
begin
|
|
NetToHost:=ntohl(net);
|
|
end;
|
|
|
|
Function ShortHostToNet (Host : Word) : Word;
|
|
|
|
begin
|
|
ShortHostToNet:=htons(host);
|
|
end;
|
|
|
|
Function ShortNetToHost (Net : Word) : Word;
|
|
|
|
begin
|
|
ShortNEtToHost:=ntohs(net);
|
|
end;
|
|
|
|
const digittab : shortstring = ('0123456789ABCDEF');
|
|
|
|
function lclinttohex (i:integer;digits:longint): ansistring;
|
|
|
|
begin
|
|
SetLength(lclinttohex,4);
|
|
lclinttohex[4]:=digittab[1+(i and 15)];
|
|
lclinttohex[3]:=digittab[1+((i shr 4) and 15)];
|
|
lclinttohex[2]:=digittab[1+((i shr 8) and 15)];
|
|
lclinttohex[1]:=digittab[1+((i shr 12) and 15)];;
|
|
end;
|
|
|
|
function HostAddrToStr6 (Entry : TIn6_Addr) :ansiString;
|
|
var
|
|
i: byte;
|
|
zr1,zr2: set of byte;
|
|
zc1,zc2: byte;
|
|
have_skipped: boolean;
|
|
begin
|
|
zr1 := [];
|
|
zr2 := [];
|
|
zc1 := 0;
|
|
zc2 := 0;
|
|
for i := 0 to 7 do begin
|
|
if Entry.u6_addr16[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
|
|
zc1 := zc2;
|
|
zr1 := zr2;
|
|
end;
|
|
SetLength(HostAddrToStr6, 8*5-1);
|
|
SetLength(HostAddrToStr6, 0);
|
|
have_skipped := false;
|
|
for i := 0 to 7 do begin
|
|
if not (i in zr1) then begin
|
|
if have_skipped then begin
|
|
if HostAddrToStr6 = ''
|
|
then HostAddrToStr6 := '::'
|
|
else HostAddrToStr6 := HostAddrToStr6 + ':';
|
|
have_skipped := false;
|
|
end;
|
|
// FIXME: is that shortnettohost really proper there? I wouldn't be too sure...
|
|
HostAddrToStr6 := HostAddrToStr6 +lclIntToHex(ShortNetToHost(Entry.u6_addr16[i]), 1) + ':';
|
|
end else begin
|
|
have_skipped := true;
|
|
end;
|
|
end;
|
|
if have_skipped then
|
|
if HostAddrToStr6 = ''
|
|
then HostAddrToStr6 := '::'
|
|
else HostAddrToStr6 := HostAddrToStr6 + ':';
|
|
|
|
if HostAddrToStr6 = '' then HostAddrToStr6 := '::';
|
|
if not (7 in zr1) then
|
|
SetLength(HostAddrToStr6, Length(HostAddrToStr6)-1);
|
|
end;
|
|
|
|
function StrToHostAddr6(IP : String) : TIn6_addr;
|
|
begin
|
|
end;
|
|
|
|
function NetAddrToStr6 (Entry : TIn6_Addr) : ansiString;
|
|
begin
|
|
netaddrtostr6 := HostAddrToStr6((Entry));
|
|
end;
|
|
|
|
function StrToNetAddr6(IP : ansiString) : TIn6_Addr;
|
|
begin
|
|
StrToNetAddr6 := StrToHostAddr6(IP);
|
|
end;
|
|
|
|
|