freepascal.compiler/docs/sockex/serverex.pp

Program Socket_Comms_Test;
{***************************************************************************
 TCP/IP Streaming Socket Server Example program.
 NumberofConnections is the number of consecutive active connections I will
 allow. I have not hit this limit yet.
 This defaults to port 5000
 The MOST Important thing to look at when doing socket calls of any kind
 is the byte order in the structure. Got caught big time with this in reference
 to the port number.
 This program runs as-is, just telnet localhost 5000 to connect to it.
 No warranty at all, I will not be responsible if this sets fire to your dog!
 
 This is exactly as I use it, I have just put the references to my db unit
 in curly brackets. It just echoes back what you type on a line by line basis
 Run it in X or on a seperate virtual console to the one you are telneting from
 as it prints a LOT of info to the console about what it is doing and such.
 I'm not a pretty coder at all, so please, no complaints about the lack of
 comments or coding style, unless they are very contructive ;p)
 
 type 'quit', minus the quotes and in lower case on the console to exit the
 program. The only problem I can see with this, is if you exit it, it does
 not shut down the connections to the telnet sessions cleanly, and therefore
 it leaves port 5000 in a TIME_WAIT state for a couple of minutes. This prevents
 you re-running the program immediately as it will not bind to the port.
 (Bind Error 98).
 If you know how to fix this, please let me know and I'll update the code.
 If you exit all your telnet sessions before shutting the server down, it
 works fine.
 
 Hope some of you find this usefull. I wrote it, purely because there is a
 big lack of examples of linux port use in FPC. And I know NO C, therefore
 the examples on the net meant nothing to me.
 
 All I ask is :-
 If you like it, use it or want to change it, please drop me an E-mail.
 
 Regards Brad Campbell
 [email protected]
  ***************************************************************************}
 
Uses Linux, Sockets, Sysutils{, dbu};

Const
	NumberofConnections = 5;
		
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;
	
Procedure ZeroConnection;
Var Loop : Integer;
Begin
For Loop := 1 to NumberOfConnections do
Connection[Loop].Connected := False;
End;


Function FreeConnections : Integer;
Var	Loop : Integer;
	Result : Integer;
Begin
Result := 0;
For Loop := 1 to NumberOfConnections do
If Not Connection[Loop].Connected then Result := Result + 1;
FreeConnections := Result;
End;

Function GetFreeConnection : Integer;
Var Loop : Integer;
	Result : Integer;
	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;
End;

Procedure PError(S : String);
Begin
	Writeln(S,SocketError);
	Halt(100);
End;

Procedure PDebug(S : String);
Begin
	Writeln(S);
End;

Procedure PDebugNOLF(S: String);
Begin
	Write(S);
End;
	
Function SockAddrtoString(InAddr : LongWord) : String;

Var
	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;
End;

Procedure WelcomeHandle(Handle, ConnNum : 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));
End;

Procedure AcceptNewConnection;
Var ConnectionNumber : Integer;
	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;
End;

Procedure SetUpSocket;
Var
	SockAddr : TInetSockAddr;

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 : ');
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;
End;
	

Procedure ServiceHandle(Handle, ConnectionNum : Integer);
Var Buffer : String;
	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));

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;
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);

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);
{ fdClose(Connection[Loop].Handle);}
 {Connection[Loop].Connected := False;}
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;
{	Else Writeln(DB_Query(Command));}
	Command := '';
	End;
End;
{DB_Tic;}	{Updates Database Internals, Needs at Least 1 run per second}
Until Quit = True;
CloseAllOpen;

End.