mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-08-25 09:09:25 +02:00
* added setsocketoptions + pulled it through source beautifier
This commit is contained in:
marco
parent
26e15a2e1d
commit
ab086a8e20
@ -38,244 +38,261 @@ Program Socket_Comms_Test;
|
||||
bcampbel@omen.net.au
|
||||
***************************************************************************}
|
||||
|
||||
{$mode ObjFPC}
|
||||
|
||||
Uses Linux, Sockets, Sysutils{, dbu};
|
||||
|
||||
Const
|
||||
NumberofConnections = 5;
|
||||
NumberofConnections = 5;
|
||||
|
||||
Type ConnectionType = Record
|
||||
IP : Cardinal;
|
||||
Port : Word;
|
||||
Handle : Integer;
|
||||
Connected : Boolean;
|
||||
IdleTimer : Integer;
|
||||
End;
|
||||
Type ConnectionType = Record
|
||||
IP : Cardinal;
|
||||
Port : Word;
|
||||
Handle : Integer;
|
||||
Connected : Boolean;
|
||||
IdleTimer : Integer;
|
||||
End;
|
||||
|
||||
|
||||
Var
|
||||
Connection : Array[1..NumberofConnections] of ConnectionType;
|
||||
FDS : FDSet;
|
||||
S : LongInt;
|
||||
PortNumber : Word;
|
||||
GreatestHandle : Integer;
|
||||
Quit : Boolean;
|
||||
Command : String;
|
||||
Connection : Array[1..NumberofConnections] Of ConnectionType;
|
||||
FDS : FDSet;
|
||||
S : LongInt;
|
||||
PortNumber : Word;
|
||||
GreatestHandle : Integer;
|
||||
Quit : Boolean;
|
||||
Command : String;
|
||||
|
||||
Procedure ZeroConnection;
|
||||
|
||||
Var Loop : Integer;
|
||||
Begin
|
||||
For Loop := 1 to NumberOfConnections do
|
||||
Connection[Loop].Connected := False;
|
||||
For Loop := 1 To NumberOfConnections Do
|
||||
Connection[Loop].Connected := False;
|
||||
End;
|
||||
|
||||
|
||||
Function FreeConnections : Integer;
|
||||
Var Loop : Integer;
|
||||
Result : Integer;
|
||||
|
||||
Var Loop : Integer;
|
||||
|
||||
Begin
|
||||
Result := 0;
|
||||
For Loop := 1 to NumberOfConnections do
|
||||
If Not Connection[Loop].Connected then Result := Result + 1;
|
||||
FreeConnections := Result;
|
||||
Result := 0;
|
||||
For Loop := 1 To NumberOfConnections Do
|
||||
If Not Connection[Loop].Connected Then Inc(Result);
|
||||
FreeConnections := Result;
|
||||
End;
|
||||
|
||||
Function GetFreeConnection : Integer;
|
||||
|
||||
Var Loop : Integer;
|
||||
Result : Integer;
|
||||
Found : Boolean;
|
||||
Found : Boolean;
|
||||
Begin
|
||||
Result := 0;
|
||||
Loop := 1;
|
||||
Found := False;
|
||||
While (Loop < NumberOfConnections + 1) and (Not Found) do
|
||||
Begin
|
||||
If Not Connection[Loop].Connected then
|
||||
Begin
|
||||
Found := True;
|
||||
Result := Loop;
|
||||
End;
|
||||
Loop := Loop + 1;
|
||||
GetFreeConnection := Result;
|
||||
End;
|
||||
Result := 0;
|
||||
Loop := 1;
|
||||
Found := False;
|
||||
While (Loop < NumberOfConnections + 1) and (Not Found) Do
|
||||
Begin
|
||||
If Not Connection[Loop].Connected Then
|
||||
Begin
|
||||
Found := True;
|
||||
Result := Loop;
|
||||
End;
|
||||
Inc(Loop);
|
||||
GetFreeConnection := Result;
|
||||
End;
|
||||
End;
|
||||
|
||||
Procedure PError(S : String);
|
||||
Begin
|
||||
Writeln(S,SocketError);
|
||||
Halt(100);
|
||||
Writeln(S,SocketError);
|
||||
Halt(100);
|
||||
End;
|
||||
|
||||
Procedure PDebug(S : String);
|
||||
Begin
|
||||
Writeln(S);
|
||||
Writeln(S);
|
||||
End;
|
||||
|
||||
Procedure PDebugNOLF(S: String);
|
||||
Begin
|
||||
Write(S);
|
||||
Write(S);
|
||||
End;
|
||||
|
||||
Function SockAddrtoString(InAddr : LongWord) : String;
|
||||
|
||||
Var
|
||||
P1,P2,P3,P4 : Byte;
|
||||
S1,S2,S3,S4 : String;
|
||||
P1,P2,P3,P4 : Byte;
|
||||
S1,S2,S3,S4 : String;
|
||||
|
||||
Begin
|
||||
P1 := (InAddr And $ff000000) Shr 24;
|
||||
P2 := (InAddr And $ff0000) Shr 16;
|
||||
P3 := (InAddr And $ff00) Shr 8;
|
||||
P4 := InAddr And $FF;
|
||||
Str(P1,S1);
|
||||
Str(P2,S2);
|
||||
Str(P3,S3);
|
||||
Str(P4,S4);
|
||||
SockAddrtoString := S4+'.'+S3+'.'+S2+'.'+S1;
|
||||
P1 := (InAddr And $ff000000) Shr 24;
|
||||
P2 := (InAddr And $ff0000) Shr 16;
|
||||
P3 := (InAddr And $ff00) Shr 8;
|
||||
P4 := InAddr And $FF;
|
||||
Str(P1,S1);
|
||||
Str(P2,S2);
|
||||
Str(P3,S3);
|
||||
Str(P4,S4);
|
||||
SockAddrtoString := S4+'.'+S3+'.'+S2+'.'+S1;
|
||||
End;
|
||||
|
||||
Procedure WelcomeHandle(Handle, ConnNum : Integer);
|
||||
Var Buffer : String;
|
||||
Sent : Integer;
|
||||
|
||||
Var Buffer : String;
|
||||
Sent : Integer;
|
||||
Begin
|
||||
Buffer := 'Welcome to Brads Server 1.0'+#10+#13+'You Are Connection '+
|
||||
InttoStr(ConnNum)+' Of '+InttoStr(NumberofConnections)+
|
||||
', With '+InttoStr(FreeConnections)+' Connections Free'#13+#10;
|
||||
Sent := Send(Handle,Buffer[1],Length(Buffer),0);
|
||||
If Sent <> Length(Buffer) then PDebug('Wanted to Send : '
|
||||
+InttoStr(Length(Buffer))+' Sent Only : '+InttoStr(Sent)+
|
||||
' to Connection : '+InttoStr(ConnNum));
|
||||
Buffer := 'Welcome to Brads Server 1.0'+#10+#13+'You Are Connection '+
|
||||
InttoStr(ConnNum)+' Of '+InttoStr(NumberofConnections)+
|
||||
', With '+InttoStr(FreeConnections)+' Connections Free'#13+#10;
|
||||
Sent := Send(Handle,Buffer[1],Length(Buffer),0);
|
||||
If Sent <> Length(Buffer) Then
|
||||
PDebug('Wanted to Send : ' +InttoStr(Length(Buffer))+' Sent Only : '
|
||||
+InttoStr(Sent)+' to Connection : '+InttoStr(ConnNum));
|
||||
End;
|
||||
|
||||
Procedure AcceptNewConnection;
|
||||
|
||||
Var ConnectionNumber : Integer;
|
||||
Handle : LongInt;
|
||||
FromAddrSize : LongInt;
|
||||
FromAddr : TInetSockAddr;
|
||||
Handle : LongInt;
|
||||
FromAddrSize : LongInt;
|
||||
FromAddr : TInetSockAddr;
|
||||
|
||||
Begin
|
||||
FromAddrSize := Sizeof(FromAddr);
|
||||
If FreeConnections > 0 then Begin
|
||||
ConnectionNumber := GetFreeConnection;
|
||||
PDebug('Accepting New Connection Number : '+InttoStr(ConnectionNumber));
|
||||
Handle := Accept(S,FromAddr,FromAddrSize);
|
||||
If Handle < 0 then PError('Accept Error!!');
|
||||
PDebug('Accepted From : '+SockAddrtoString(FromAddr.Addr)+' Port : '
|
||||
+Inttostr(Swap(FromAddr.Port)));
|
||||
Connection[ConnectionNumber].Handle := Handle;
|
||||
Connection[ConnectionNumber].IP := FromAddr.Addr;
|
||||
Connection[ConnectionNumber].Port := FromAddr.Port;
|
||||
Connection[ConnectionNumber].Connected := True;
|
||||
Connection[ConnectionNumber].IdleTimer := 0;
|
||||
WelcomeHandle(Handle,ConnectionNumber);
|
||||
End;
|
||||
FromAddrSize := Sizeof(FromAddr);
|
||||
If FreeConnections > 0 Then
|
||||
Begin
|
||||
ConnectionNumber := GetFreeConnection;
|
||||
PDebug('Accepting New Connection Number : '+InttoStr(ConnectionNumber));
|
||||
Handle := Accept(S,FromAddr,FromAddrSize);
|
||||
If Handle < 0 Then PError('Accept Error!!');
|
||||
PDebug('Accepted From : '+SockAddrtoString(FromAddr.Addr)+' Port : '
|
||||
+Inttostr(Swap(FromAddr.Port)));
|
||||
Connection[ConnectionNumber].Handle := Handle;
|
||||
Connection[ConnectionNumber].IP := FromAddr.Addr;
|
||||
Connection[ConnectionNumber].Port := FromAddr.Port;
|
||||
Connection[ConnectionNumber].Connected := True;
|
||||
Connection[ConnectionNumber].IdleTimer := 0;
|
||||
WelcomeHandle(Handle,ConnectionNumber);
|
||||
End;
|
||||
End;
|
||||
|
||||
Procedure SetUpSocket;
|
||||
|
||||
Var
|
||||
SockAddr : TInetSockAddr;
|
||||
SockAddr : TInetSockAddr;
|
||||
yes : longint;
|
||||
|
||||
Begin
|
||||
SockAddr.Family := AF_INET;
|
||||
SockAddr.Port := Swap(PortNumber);
|
||||
SockAddr.Addr := 0;
|
||||
S := Socket(AF_INET,SOCK_STREAM,0);
|
||||
If SocketError <> 0 then PError('Socket Error : ');
|
||||
If not Bind(S,SockAddr,SizeOf(SockAddr)) then PError('Bind Error : ');
|
||||
If not Listen(S,5) then PError('Listen Error : ');
|
||||
SockAddr.Family := AF_INET;
|
||||
SockAddr.Port := Swap(PortNumber);
|
||||
SockAddr.Addr := 0;
|
||||
S := Socket(AF_INET,SOCK_STREAM,0);
|
||||
If SocketError <> 0 Then PError('Socket Error : ');
|
||||
yes := $1010101; {Copied this from existing code. Value is empiric,
|
||||
but works. (yes=true<>0) }
|
||||
SetSocketOptions(s, SOL_SOCKET, SO_REUSEADDR,yes,sizeof(yes));
|
||||
If Not Bind(S,SockAddr,SizeOf(SockAddr)) Then PError('Bind Error : ');
|
||||
If Not Listen(S,5) Then PError('Listen Error : ');
|
||||
End;
|
||||
|
||||
Procedure LoadConnectedFDS;
|
||||
|
||||
Var Loop : Integer;
|
||||
Begin
|
||||
For Loop := 1 to NumberOfConnections Do
|
||||
If Connection[Loop].Connected then
|
||||
Begin
|
||||
FD_SET(Connection[Loop].Handle,FDS);
|
||||
If Connection[Loop].Handle > GreatestHandle then
|
||||
GreatestHandle := Connection[Loop].Handle;
|
||||
End;
|
||||
For Loop := 1 To NumberOfConnections Do
|
||||
If Connection[Loop].Connected Then
|
||||
Begin
|
||||
FD_SET(Connection[Loop].Handle,FDS);
|
||||
If Connection[Loop].Handle > GreatestHandle Then
|
||||
GreatestHandle := Connection[Loop].Handle;
|
||||
End;
|
||||
End;
|
||||
|
||||
|
||||
Procedure ServiceHandle(Handle, ConnectionNum : Integer);
|
||||
|
||||
Var Buffer : String;
|
||||
Sent, BufferLength : Integer;
|
||||
Sent, BufferLength : Integer;
|
||||
|
||||
Begin
|
||||
Writeln('Service Handle : ',Handle);
|
||||
BufferLength := Recv(Handle,Buffer[1],200,0);
|
||||
Setlength(Buffer,BufferLength);
|
||||
If SocketError <> 0 then PDebug('Reciceved Socket Error : '
|
||||
+InttoStr(SocketError)+' OnHandle '+InttoStr(Handle));
|
||||
Writeln('Service Handle : ',Handle);
|
||||
BufferLength := Recv(Handle,Buffer[1],200,0);
|
||||
Setlength(Buffer,BufferLength);
|
||||
If SocketError <> 0 Then
|
||||
PDebug('Reciceved Socket Error : '
|
||||
+InttoStr(SocketError)+' OnHandle '+InttoStr(Handle));
|
||||
|
||||
If BufferLength = 0 then {It's EOF, Socket has been closed}
|
||||
Begin
|
||||
PDebug('Socket Handle '+InttoStr(Handle)+' Closed');
|
||||
Connection[ConnectionNum].Connected := False;
|
||||
Shutdown(Handle,2);
|
||||
fdClose(Handle);
|
||||
End
|
||||
If BufferLength = 0 Then {It's EOF, Socket has been closed}
|
||||
Begin
|
||||
PDebug('Socket Handle '+InttoStr(Handle)+' Closed');
|
||||
Connection[ConnectionNum].Connected := False;
|
||||
Shutdown(Handle,2);
|
||||
fdClose(Handle);
|
||||
End
|
||||
|
||||
Else Begin
|
||||
PDebug(InttoStr(BufferLength)+' Bytes Recieved');
|
||||
{Buffer := Db_Query(Buffer);}
|
||||
Sent := Send(Handle,Buffer[1],Length(Buffer),0);
|
||||
If Sent <> Bufferlength then
|
||||
PDebug('Wanted to Send : '+InttoStr(Length(Buffer))+' Only Sent : '+InttoStr(Sent));
|
||||
End;
|
||||
Else
|
||||
Begin
|
||||
PDebug(InttoStr(BufferLength)+' Bytes Recieved');
|
||||
{Buffer := Db_Query(Buffer);}
|
||||
Sent := Send(Handle,Buffer[1],Length(Buffer),0);
|
||||
If Sent <> Bufferlength Then
|
||||
PDebug('Wanted to Send : '+InttoStr(Length(Buffer))+' Only Sent : '+InttoStr(Sent));
|
||||
End;
|
||||
End;
|
||||
|
||||
Procedure ServiceSockets;
|
||||
|
||||
Var Loop : Integer;
|
||||
|
||||
Begin
|
||||
For Loop := 1 to NumberOfConnections do
|
||||
If Connection[Loop].Connected then
|
||||
If FD_ISSET(Connection[Loop].Handle,FDS) Then
|
||||
ServiceHandle(Connection[Loop].Handle,Loop);
|
||||
For Loop := 1 To NumberOfConnections Do
|
||||
If Connection[Loop].Connected Then
|
||||
If FD_ISSET(Connection[Loop].Handle,FDS) Then
|
||||
ServiceHandle(Connection[Loop].Handle,Loop);
|
||||
|
||||
IF FD_ISSET(S,FDS) then AcceptNewConnection;
|
||||
If FD_ISSET(S,FDS) Then AcceptNewConnection;
|
||||
End;
|
||||
|
||||
Procedure CloseAllOpen;
|
||||
|
||||
Var Loop : Integer;
|
||||
Begin
|
||||
For Loop := 1 to NumberOfConnections do
|
||||
Begin
|
||||
If Connection[Loop].Connected = True then
|
||||
Begin
|
||||
Shutdown(Connection[Loop].Handle,1);
|
||||
For Loop := 1 To NumberOfConnections Do
|
||||
Begin
|
||||
If Connection[Loop].Connected = True Then
|
||||
Begin
|
||||
Shutdown(Connection[Loop].Handle,1);
|
||||
{ fdClose(Connection[Loop].Handle);}
|
||||
{Connection[Loop].Connected := False;}
|
||||
End;
|
||||
End;
|
||||
End;
|
||||
End;
|
||||
End;
|
||||
|
||||
begin
|
||||
ZeroConnection; {Clear Connected Array}
|
||||
Quit := False;
|
||||
PortNumber := 5000;
|
||||
SetupSocket;
|
||||
Repeat
|
||||
FD_ZERO(FDS);
|
||||
FD_SET(S,FDS); { Socket Looking for new connections }
|
||||
FD_SET(1,FDS); { Terminal }
|
||||
GreatestHandle := S;
|
||||
LoadConnectedFDS;
|
||||
If Select(GreatestHandle+1,@FDS,nil,nil,1000) > 0 then
|
||||
Begin
|
||||
ServiceSockets;
|
||||
If FD_ISSET(1,FDS) then
|
||||
Begin
|
||||
PDebug('Reading Console');
|
||||
Readln(Command);
|
||||
If Command='quit' then quit := True;
|
||||
ZeroConnection; {Clear Connected Array}
|
||||
Quit := False;
|
||||
PortNumber := 5000;
|
||||
SetupSocket;
|
||||
Repeat
|
||||
FD_ZERO(FDS);
|
||||
FD_SET(S,FDS); { Socket Looking for new connections }
|
||||
FD_SET(1,FDS); { Terminal }
|
||||
GreatestHandle := S;
|
||||
LoadConnectedFDS;
|
||||
If Select(GreatestHandle+1,@FDS,Nil,Nil,1000) > 0 Then
|
||||
Begin
|
||||
ServiceSockets;
|
||||
If FD_ISSET(1,FDS) Then
|
||||
Begin
|
||||
PDebug('Reading Console');
|
||||
Readln(Command);
|
||||
If Command='quit' Then quit := True;
|
||||
{ Else Writeln(DB_Query(Command));}
|
||||
Command := '';
|
||||
End;
|
||||
End;
|
||||
{DB_Tic;} {Updates Database Internals, Needs at Least 1 run per second}
|
||||
Until Quit = True;
|
||||
CloseAllOpen;
|
||||
Command := '';
|
||||
End;
|
||||
End;
|
||||
{DB_Tic;} {Updates Database Internals, Needs at Least 1 run per second}
|
||||
Until Quit = True;
|
||||
CloseAllOpen;
|
||||
|
||||
End.
|
||||
Loading…
Reference in New Issue
Block a user