eric
/
mysticbbs
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

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
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

8
mystic/mis.pas
View File

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

4
mystic/mis_client_ftp.pas
View File

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

8
mystic/mis_client_nntp.pas
View File

@ -84,7 +84,7 @@ End;
Procedure TNNTPServer.ClientWriteLine (Str: String);
Begin
Server.Server.Status('S:' + Str);
Server.Status('S:' + Str);
Client.WriteLine(Str);
End;
@ -127,7 +127,7 @@ Begin
ClientWriteLine(re_UnknownOption);
If LoggedIn Then
Server.Server.Status('Logged in as ' + UserName);
Server.Status('Logged in as ' + UserName);
End;
Procedure TNNTPServer.cmd_GROUP;
@ -320,7 +320,7 @@ Begin
If HackCount >= HackThreshold Then Begin
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;
@ -616,7 +616,7 @@ Begin
If Client.ReadLine(Str) = -1 Then Exit;
Server.Server.Status('C:' + Str);
Server.Status('C:' + Str);
Cmd := strUpper(strWordGet(1, Str, ' '));

4
mystic/mis_client_pop3.pas
View File

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

10
mystic/mis_client_smtp.pas
View File

@ -85,17 +85,17 @@ Begin
InDomain := Copy(Data, Pos('@', Data) + 1, Pos('>', Data) - Pos('@', Data) - 1);
If IsFrom Then
Server.Server.Status('User: ' + InName + ' Domain: ' + InDomain);
Server.Status('User: ' + InName + ' Domain: ' + InDomain);
If InDomain <> bbsConfig.iNetDomain Then Begin
Server.Server.Status('Refused by domain: ' + InName + '@' + InDomain);
Server.Status('Refused by domain: ' + InName + '@' + InDomain);
Exit;
End;
Result := SearchForUser(InName, User, UserPos);
If Not Result Then
Server.Server.Status('Refused by name: ' + InName + '@' + InDomain);
Server.Status('Refused by name: ' + InName + '@' + InDomain);
End;
Procedure TSMTPServer.ResetSession;
@ -191,7 +191,7 @@ Begin
If HackCount >= SMTPHackThresh Then Begin
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;
Exit;
End;
@ -251,7 +251,7 @@ Begin
End;
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;

65
mystic/mis_server.pas
View File

@ -10,14 +10,20 @@ Uses
MIS_Common,
MIS_NodeData;
Const
MaxStatusText = 20;
Type
TServerManager = Class;
TServerClient = Class;
TServerCreateProc = Function (Manager: TServerManager; Config: RecConfig; ND: TNodeData; Client: TSocketClass): TServerClient;
TServerManager = Class(TThread)
Critical : TRTLCriticalSection;
NodeInfo : TNodeData;
Server : TSocketClass;
ServerStatus : TStringList;
StatusUpdated : Boolean;
ClientList : TList;
NewClientProc : TServerCreateProc;
Config : RecConfig;
@ -33,6 +39,7 @@ Type
Constructor Create (Config: RecConfig; PortNum: Word; CliMax: Word; ND: TNodeData; CreateProc: TServerCreateProc);
Destructor Destroy; Override;
Procedure Execute; Override;
Procedure Status (Str: String);
Function CheckIP (IP, Mask: String) : Boolean;
Function IsBlockedIP (Var Client: TSocketClass) : Boolean;
Function DuplicateIPs (Var Client: TSocketClass) : Byte;
@ -58,6 +65,8 @@ Var
Begin
Inherited Create(False);
InitCriticalSection(Critical);
Port := PortNum;
ClientMax := CliMax;
ClientRefused := 0;
@ -67,6 +76,8 @@ Begin
ClientMaxIPs := 1;
NewClientProc := CreateProc;
Server := TSocketClass.Create;
ServerStatus := TStringList.Create;
StatusUpdated := False;
ClientList := TList.Create;
TextPath := Config.DataPath;
NodeInfo := ND;
@ -147,21 +158,54 @@ Begin
Inc(Result);
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;
Var
NewClient : TSocketClass;
Begin
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);
If Terminated Then Exit;
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
NewClient := Server.WaitConnection;
@ -170,31 +214,31 @@ Begin
If (ClientMax > 0) And (ClientActive >= ClientMax) Then Begin
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');
NewClient.Free;
End Else
If IsBlockedIP(NewClient) Then Begin
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');
NewClient.Free;
End Else
If (ClientMaxIPs > 0) and (DuplicateIPs(NewClient) > ClientMaxIPs) Then Begin
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');
NewClient.Free;
End Else Begin
Inc (ClientTotal);
Inc (ClientActive);
Server.Status ('Connect: ' + NewClient.PeerIP + ' (' + NewClient.PeerName + ')');
Status ('Connect: ' + NewClient.PeerIP + ' (' + NewClient.PeerName + ')');
NewClientProc(Self, Config, NodeInfo, NewClient);
End;
Until Terminated;
Server.Status ('Shutting down server...');
Status ('Shutting down server...');
End;
Destructor TServerManager.Destroy;
@ -220,7 +264,10 @@ Begin
ClientList.Pack;
End;
DoneCriticalSection(Critical);
ClientList.Free;
ServerStatus.Free;
Server.Free;
Inherited Destroy;
@ -251,7 +298,7 @@ Begin
Manager.ClientList[Manager.ClientList.IndexOf(Self)] := NIL;
If Manager.Server <> NIL Then
Manager.Server.StatusUpdated := True;
Manager.StatusUpdated := True;
Dec (Manager.ClientActive);