Moved status class to TServerManager, away from the Socket class

This commit is contained in:
mysticbbs 2012-08-08 02:31:06 -04:00
parent 1857a56021
commit 990db65e12
6 changed files with 73 additions and 26 deletions

View File

@ -199,7 +199,7 @@ Var
Begin Begin
If FocusPtr = NIL Then Exit; If FocusPtr = NIL Then Exit;
FocusPtr.Server.StatusUpdated := False; FocusPtr.StatusUpdated := False;
// UPDATE CONNECTION STATS // UPDATE CONNECTION STATS
@ -210,12 +210,12 @@ Begin
// UPDATE STATUS MESSAGES // UPDATE STATUS MESSAGES
Offset := FocusPtr.Server.SocketStatus.Count; Offset := FocusPtr.ServerStatus.Count;
For Count := 22 DownTo 15 Do Begin For Count := 22 DownTo 15 Do Begin
If Offset > 0 Then Begin If Offset > 0 Then Begin
Dec(Offset); Dec(Offset);
Console.WriteXY (4, Count, 7, strPadR(FocusPtr.Server.SocketStatus.Strings[Offset], 74, ' ')); Console.WriteXY (4, Count, 7, strPadR(FocusPtr.ServerStatus.Strings[Offset], 74, ' '));
End Else End Else
Console.WriteXY (4, Count, 7, strPadR(' ', 74, ' ')); Console.WriteXY (4, Count, 7, strPadR(' ', 74, ' '));
End; End;
@ -573,7 +573,7 @@ Begin
End; End;
If (FocusPtr <> NIL) Then If (FocusPtr <> NIL) Then
If FocusPtr.Server.StatusUpdated Then Begin If FocusPtr.StatusUpdated Then Begin
UpdateStatus; UpdateStatus;
Count := 1; Count := 1;
End Else End Else

View File

@ -380,7 +380,7 @@ Begin
GetSecurityLevel(User.Security, SecLevel); GetSecurityLevel(User.Security, SecLevel);
Server.Server.Status (User.Handle + ' logged in'); Server.Status (User.Handle + ' logged in');
End Else End Else
Client.WriteLine(re_BadPW); Client.WriteLine(re_BadPW);
End; End;
@ -795,7 +795,7 @@ Begin
If GotQuit Then Begin If GotQuit Then Begin
Client.WriteLine(re_Goodbye); Client.WriteLine(re_Goodbye);
Server.Server.Status (User.Handle + ' logged out'); Server.Status (User.Handle + ' logged out');
End; End;
End; End;

View File

@ -84,7 +84,7 @@ End;
Procedure TNNTPServer.ClientWriteLine (Str: String); Procedure TNNTPServer.ClientWriteLine (Str: String);
Begin Begin
Server.Server.Status('S:' + Str); Server.Status('S:' + Str);
Client.WriteLine(Str); Client.WriteLine(Str);
End; End;
@ -127,7 +127,7 @@ Begin
ClientWriteLine(re_UnknownOption); ClientWriteLine(re_UnknownOption);
If LoggedIn Then If LoggedIn Then
Server.Server.Status('Logged in as ' + UserName); Server.Status('Logged in as ' + UserName);
End; End;
Procedure TNNTPServer.cmd_GROUP; Procedure TNNTPServer.cmd_GROUP;
@ -320,7 +320,7 @@ Begin
If HackCount >= HackThreshold Then Begin If HackCount >= HackThreshold Then Begin
EndSession := True; // someone is being a douchebag EndSession := True; // someone is being a douchebag
Server.Server.Status('Flood attempt from ' + Client.PeerIP + '. Goodbye'); Server.Status('Flood attempt from ' + Client.PeerIP + '. Goodbye');
MsgText.Free; MsgText.Free;
@ -616,7 +616,7 @@ Begin
If Client.ReadLine(Str) = -1 Then Exit; If Client.ReadLine(Str) = -1 Then Exit;
Server.Server.Status('C:' + Str); Server.Status('C:' + Str);
Cmd := strUpper(strWordGet(1, Str, ' ')); Cmd := strUpper(strWordGet(1, Str, ' '));

View File

@ -299,7 +299,7 @@ Begin
Client.WriteLine(re_LoggedIn); Client.WriteLine(re_LoggedIn);
Server.Server.Status(User.Handle + ' logged in'); Server.Status(User.Handle + ' logged in');
End Else End Else
Client.WriteLine(re_BadLogin); Client.WriteLine(re_BadLogin);
End; End;
@ -476,7 +476,7 @@ Begin
If GotQuit Then Begin If GotQuit Then Begin
Client.WriteLine(re_Goodbye); Client.WriteLine(re_Goodbye);
Server.Server.Status (User.Handle + ' logged out'); Server.Status (User.Handle + ' logged out');
DeleteMessages; DeleteMessages;
End; End;

View File

@ -85,17 +85,17 @@ Begin
InDomain := Copy(Data, Pos('@', Data) + 1, Pos('>', Data) - Pos('@', Data) - 1); InDomain := Copy(Data, Pos('@', Data) + 1, Pos('>', Data) - Pos('@', Data) - 1);
If IsFrom Then If IsFrom Then
Server.Server.Status('User: ' + InName + ' Domain: ' + InDomain); Server.Status('User: ' + InName + ' Domain: ' + InDomain);
If InDomain <> bbsConfig.iNetDomain Then Begin If InDomain <> bbsConfig.iNetDomain Then Begin
Server.Server.Status('Refused by domain: ' + InName + '@' + InDomain); Server.Status('Refused by domain: ' + InName + '@' + InDomain);
Exit; Exit;
End; End;
Result := SearchForUser(InName, User, UserPos); Result := SearchForUser(InName, User, UserPos);
If Not Result Then If Not Result Then
Server.Server.Status('Refused by name: ' + InName + '@' + InDomain); Server.Status('Refused by name: ' + InName + '@' + InDomain);
End; End;
Procedure TSMTPServer.ResetSession; Procedure TSMTPServer.ResetSession;
@ -191,7 +191,7 @@ Begin
If HackCount >= SMTPHackThresh Then Begin If HackCount >= SMTPHackThresh Then Begin
EndSession := True; // someone is being a douchebag EndSession := True; // someone is being a douchebag
Server.Server.Status('Flood attempt from ' + FromName + ' (' + Client.PeerIP + '); Goodbye'); Server.Status('Flood attempt from ' + FromName + ' (' + Client.PeerIP + '); Goodbye');
MsgText.Free; MsgText.Free;
Exit; Exit;
End; End;
@ -251,7 +251,7 @@ Begin
End; End;
For MsgLoop := 0 To ToList.Count - 1 Do Begin For MsgLoop := 0 To ToList.Count - 1 Do Begin
Server.Server.Status('Sending mail from ' + FromName + ' to ' + ToList.Strings[MsgLoop]); Server.Status('Sending mail from ' + FromName + ' to ' + ToList.Strings[MsgLoop]);
MsgBase^.StartNewMsg; MsgBase^.StartNewMsg;

View File

@ -10,14 +10,20 @@ Uses
MIS_Common, MIS_Common,
MIS_NodeData; MIS_NodeData;
Const
MaxStatusText = 20;
Type Type
TServerManager = Class; TServerManager = Class;
TServerClient = Class; TServerClient = Class;
TServerCreateProc = Function (Manager: TServerManager; Config: RecConfig; ND: TNodeData; Client: TSocketClass): TServerClient; TServerCreateProc = Function (Manager: TServerManager; Config: RecConfig; ND: TNodeData; Client: TSocketClass): TServerClient;
TServerManager = Class(TThread) TServerManager = Class(TThread)
Critical : TRTLCriticalSection;
NodeInfo : TNodeData; NodeInfo : TNodeData;
Server : TSocketClass; Server : TSocketClass;
ServerStatus : TStringList;
StatusUpdated : Boolean;
ClientList : TList; ClientList : TList;
NewClientProc : TServerCreateProc; NewClientProc : TServerCreateProc;
Config : RecConfig; Config : RecConfig;
@ -33,6 +39,7 @@ Type
Constructor Create (Config: RecConfig; PortNum: Word; CliMax: Word; ND: TNodeData; CreateProc: TServerCreateProc); Constructor Create (Config: RecConfig; PortNum: Word; CliMax: Word; ND: TNodeData; CreateProc: TServerCreateProc);
Destructor Destroy; Override; Destructor Destroy; Override;
Procedure Execute; Override; Procedure Execute; Override;
Procedure Status (Str: String);
Function CheckIP (IP, Mask: String) : Boolean; Function CheckIP (IP, Mask: String) : Boolean;
Function IsBlockedIP (Var Client: TSocketClass) : Boolean; Function IsBlockedIP (Var Client: TSocketClass) : Boolean;
Function DuplicateIPs (Var Client: TSocketClass) : Byte; Function DuplicateIPs (Var Client: TSocketClass) : Byte;
@ -58,6 +65,8 @@ Var
Begin Begin
Inherited Create(False); Inherited Create(False);
InitCriticalSection(Critical);
Port := PortNum; Port := PortNum;
ClientMax := CliMax; ClientMax := CliMax;
ClientRefused := 0; ClientRefused := 0;
@ -67,6 +76,8 @@ Begin
ClientMaxIPs := 1; ClientMaxIPs := 1;
NewClientProc := CreateProc; NewClientProc := CreateProc;
Server := TSocketClass.Create; Server := TSocketClass.Create;
ServerStatus := TStringList.Create;
StatusUpdated := False;
ClientList := TList.Create; ClientList := TList.Create;
TextPath := Config.DataPath; TextPath := Config.DataPath;
NodeInfo := ND; NodeInfo := ND;
@ -147,21 +158,54 @@ Begin
Inc(Result); Inc(Result);
End; End;
Procedure TServerManager.Status (Str: String);
Var
Res : String;
Begin
If ServerStatus = NIL Then Exit;
EnterCriticalSection(Critical);
Try
If ServerStatus.Count > MaxStatusText Then
ServerStatus.Delete(0);
Res := '(' + Copy(DateDos2Str(CurDateDos, 1), 1, 5) + ' ' + TimeDos2Str(CurDateDos, False) + ') ' + Str;
If Length(Res) > 74 Then Begin
ServerStatus.Add(Copy(Res, 1, 74));
If ServerStatus.Count > MaxStatusText Then
ServerStatus.Delete(0);
ServerStatus.Add(strRep(' ', 14) + Copy(Res, 75, 255));
End Else
ServerStatus.Add(Res);
Except
{ ignore exceptions here -- happens when socketstatus is NIL}
{ need to review criticals now that they are in FP's RTL}
End;
StatusUpdated := True;
LeaveCriticalSection(Critical);
End;
Procedure TServerManager.Execute; Procedure TServerManager.Execute;
Var Var
NewClient : TSocketClass; NewClient : TSocketClass;
Begin Begin
Repeat Until Server <> NIL; // Synchronize with server class Repeat Until Server <> NIL; // Synchronize with server class
Repeat Until Server.SocketStatus <> NIL; // Syncronize with status class Repeat Until ServerStatus <> NIL; // Syncronize with status class
Server.WaitInit(Port); Server.WaitInit(Port);
If Terminated Then Exit; If Terminated Then Exit;
If ClientMax = 0 Then If ClientMax = 0 Then
Server.Status('WARNING: At least one server is configured with 0 max clients.'); Status('WARNING: At least one server is configured with 0 max clients.');
Server.Status('Opening server socket on port ' + strI2S(Port)); Status('Opening server socket on port ' + strI2S(Port));
Repeat Repeat
NewClient := Server.WaitConnection; NewClient := Server.WaitConnection;
@ -170,31 +214,31 @@ Begin
If (ClientMax > 0) And (ClientActive >= ClientMax) Then Begin If (ClientMax > 0) And (ClientActive >= ClientMax) Then Begin
Inc (ClientRefused); Inc (ClientRefused);
Server.Status ('BUSY: ' + NewClient.PeerIP + ' (' + NewClient.PeerName + ')'); Status ('BUSY: ' + NewClient.PeerIP + ' (' + NewClient.PeerName + ')');
If Not NewClient.WriteFile(TextPath + 'busy.txt') Then NewClient.WriteLine('BUSY'); If Not NewClient.WriteFile(TextPath + 'busy.txt') Then NewClient.WriteLine('BUSY');
NewClient.Free; NewClient.Free;
End Else End Else
If IsBlockedIP(NewClient) Then Begin If IsBlockedIP(NewClient) Then Begin
Inc (ClientBlocked); Inc (ClientBlocked);
Server.Status('BLOCK: ' + NewClient.PeerIP + ' (' + NewClient.PeerName + ')'); Status('BLOCK: ' + NewClient.PeerIP + ' (' + NewClient.PeerName + ')');
If Not NewClient.WriteFile(TextPath + 'blocked.txt') Then NewClient.WriteLine('BLOCKED'); If Not NewClient.WriteFile(TextPath + 'blocked.txt') Then NewClient.WriteLine('BLOCKED');
NewClient.Free; NewClient.Free;
End Else End Else
If (ClientMaxIPs > 0) and (DuplicateIPs(NewClient) > ClientMaxIPs) Then Begin If (ClientMaxIPs > 0) and (DuplicateIPs(NewClient) > ClientMaxIPs) Then Begin
Inc (ClientRefused); Inc (ClientRefused);
Server.Status('MULTI: ' + NewClient.PeerIP + ' (' + NewClient.PeerName + ')'); Status('MULTI: ' + NewClient.PeerIP + ' (' + NewClient.PeerName + ')');
If Not NewClient.WriteFile(TextPath + 'dupeip.txt') Then NewClient.WriteLine('Only ' + strI2S(ClientMaxIPs) + ' connection(s) per user'); If Not NewClient.WriteFile(TextPath + 'dupeip.txt') Then NewClient.WriteLine('Only ' + strI2S(ClientMaxIPs) + ' connection(s) per user');
NewClient.Free; NewClient.Free;
End Else Begin End Else Begin
Inc (ClientTotal); Inc (ClientTotal);
Inc (ClientActive); Inc (ClientActive);
Server.Status ('Connect: ' + NewClient.PeerIP + ' (' + NewClient.PeerName + ')'); Status ('Connect: ' + NewClient.PeerIP + ' (' + NewClient.PeerName + ')');
NewClientProc(Self, Config, NodeInfo, NewClient); NewClientProc(Self, Config, NodeInfo, NewClient);
End; End;
Until Terminated; Until Terminated;
Server.Status ('Shutting down server...'); Status ('Shutting down server...');
End; End;
Destructor TServerManager.Destroy; Destructor TServerManager.Destroy;
@ -220,7 +264,10 @@ Begin
ClientList.Pack; ClientList.Pack;
End; End;
DoneCriticalSection(Critical);
ClientList.Free; ClientList.Free;
ServerStatus.Free;
Server.Free; Server.Free;
Inherited Destroy; Inherited Destroy;
@ -251,7 +298,7 @@ Begin
Manager.ClientList[Manager.ClientList.IndexOf(Self)] := NIL; Manager.ClientList[Manager.ClientList.IndexOf(Self)] := NIL;
If Manager.Server <> NIL Then If Manager.Server <> NIL Then
Manager.Server.StatusUpdated := True; Manager.StatusUpdated := True;
Dec (Manager.ClientActive); Dec (Manager.ClientActive);