Added support for NNTP message posting

This commit is contained in:
mysticbbs 2012-06-16 06:38:37 -04:00
parent 82ac1411a4
commit 46d767d999
1 changed files with 208 additions and 14 deletions

View File

@ -29,6 +29,7 @@ Type
UserPos : LongInt; UserPos : LongInt;
MBase : RecMessageBase; MBase : RecMessageBase;
MBasePos : LongInt; MBasePos : LongInt;
EndSession : Boolean;
Constructor Create (Owner: TServerManager; CliSock: TSocketClass); Constructor Create (Owner: TServerManager; CliSock: TSocketClass);
Procedure Execute; Override; Procedure Execute; Override;
@ -40,18 +41,23 @@ Type
Procedure cmd_AUTHINFO; Procedure cmd_AUTHINFO;
Procedure cmd_GROUP; Procedure cmd_GROUP;
Procedure cmd_LIST; Procedure cmd_LIST;
Procedure cmd_POST;
Procedure cmd_XOVER; Procedure cmd_XOVER;
End; End;
Implementation Implementation
Uses Uses
Classes,
bbs_MsgBase_ABS, bbs_MsgBase_ABS,
bbs_MsgBase_JAM, bbs_MsgBase_JAM,
bbs_MsgBase_Squish; bbs_MsgBase_Squish;
Const Const
FileReadBuffer = 2048; FileReadBuffer = 2048;
HackThreshold = 10000;
fn_SemFileEcho = 'echomail.now';
fn_SemFileNews = 'newsmail.now';
re_Greeting = '200 Mystic BBS NNTP server ready'; re_Greeting = '200 Mystic BBS NNTP server ready';
re_Goodbye = '205 Goodbye'; re_Goodbye = '205 Goodbye';
@ -88,6 +94,7 @@ Begin
UserName := ''; UserName := '';
UserPos := -1; UserPos := -1;
MBasePos := -1; MBasePos := -1;
EndSession := False;
End; End;
Procedure TNNTPServer.cmd_AUTHINFO; Procedure TNNTPServer.cmd_AUTHINFO;
@ -251,6 +258,192 @@ Begin
ClientWriteLine('.'); ClientWriteLine('.');
End; End;
Procedure TNNTPServer.cmd_POST;
Var
MsgBase : PMsgBaseABS;
MBaseFile : TBufFile;
TempBase : RecMessageBase;
MsgText : TStringList;
Subject : String;
Newsgroup : String;
InData : String;
HackCount : LongInt;
Count : LongInt;
GotStart : Boolean;
Found : Boolean;
SemFile : File;
Begin
If Not LoggedIn Then Begin
ClientWriteLine(re_AuthReq);
Exit;
End;
ClientWriteLine('340 Send article to be posted. End with <CRLF>.<CRLF>');
Subject := '';
Newsgroup := '';
GotStart := False;
MsgText := TStringList.Create;
Repeat
Client.ReadLine(InData);
If InData = '.' Then Break;
If Not GotStart And (Pos('Newsgroups:', InData) > 0) Then Begin
Newsgroup := Copy(InData, 13, 255);
Continue;
End;
If Not GotStart And (Pos('Subject:', InData) > 0) Then Begin
Subject := Copy(InData, 10, 255);
Continue;
End;
If (InData = '') And Not GotStart Then Begin
GotStart := True;
Continue;
End;
If MsgText.Count >= mysMaxMsgLines Then Begin
HackCount := 0;
While Not Terminated And (InData <> '.') Do Begin
Client.ReadLine(InData);
Inc (HackCount);
If HackCount >= HackThreshold Then Begin
EndSession := True; // someone is being a douchebag
Server.Server.Status('Flood attempt from ' + Client.PeerIP + '. Goodbye');
MsgText.Free;
Exit;
End;
End;
Break;
End;
If GotStart Then MsgText.Add(InData);
Until Terminated;
If Terminated Then Exit;
If (Subject = '') Then Begin
MsgText.Free;
ClientWriteLine('441 No subject; message not posted');
Exit;
End;
Found := False;
MBaseFile := TBufFile.Create(FileReadBuffer);
If MBaseFile.Open(bbsConfig.DataPath + 'mbases.dat', fmOpen, fmRWDN, SizeOf(RecMessageBase)) Then Begin
MBaseFile.Read(TempBase);
While Not MBaseFile.EOF Do Begin
MBaseFile.Read(TempBase);
If TempBase.NewsName = Newsgroup Then Begin
Found := True;
Break;
End;
End;
End;
MBaseFile.Free;
If Not Found or (Newsgroup = '') Then Begin
MsgText.Free;
ClientWriteLine('441 No newsgroup selected');
Exit;
End;
If Not CheckAccess(User, True, TempBase.PostACS) or (TempBase.NetType = 3) Then Begin
MsgText.Free;
ClientWriteLine('441 No post access');
Exit;
End;
Case TempBase.BaseType of
0 : MsgBase := New(PMsgBaseJAM, Init);
1 : MsgBase := New(PMsgBaseSquish, Init);
End;
MsgBase^.SetMsgPath (TempBase.Path + TempBase.FileName);
If Not MsgBase^.OpenMsgBase Then
If Not MsgBase^.CreateMsgBase (TempBase.MaxMsgs, TempBase.MaxAge) Then Begin
Dispose(MsgBase, Done);
MsgText.Free;
Client.WriteLine('441 Cannot save');
Exit;
End Else
If Not MsgBase^.OpenMsgBase Then Begin
Dispose(MsgBase, Done);
MsgText.Free;
Client.WriteLine('411 Cannot save');
Exit;
End;
MsgBase^.StartNewMsg;
MsgBase^.SetLocal (True);
MsgBase^.SetDate (FormatDateTime('mm/dd/yy', Now));
MsgBase^.SetTime (FormatDateTime('hh:nn', Now));
MsgBase^.SetTo ('All');
MsgBase^.SetSubj (Subject);
If TempBase.Flags And MBRealNames <> 0 Then
MsgBase^.SetFrom(User.RealName)
Else
MsgBase^.SetFrom(User.Handle);
If TempBase.NetType > 0 Then Begin
MsgBase^.SetMailType(mmtEchoMail);
Case TempBase.NetType of
1 : Assign (SemFile, bbsConfig.SemaPath + fn_SemFileEcho);
2 : Assign (SemFile, bbsConfig.SemaPath + fn_SemFileNews);
End;
ReWrite (SemFile);
Close (SemFile);
End Else
MsgBase^.SetMailType(mmtNormal);
MsgBase^.SetPriv (TempBase.Flags and MBPrivate <> 0);
For Count := 1 to MsgText.Count Do Begin
InData := MsgText.Strings[Count - 1];
If Length(InData) > 79 Then InData[0] := #79;
MsgBase^.DoStringLn(InData);
End;
MsgBase^.WriteMsg;
MsgBase^.CloseMsgBase;
Dispose (MsgBase, Done);
MsgText.Free;
ClientWriteLine ('240 Artical posted ok');
End;
Procedure TNNTPServer.cmd_XOVER; Procedure TNNTPServer.cmd_XOVER;
Var Var
First : LongInt = 0; First : LongInt = 0;
@ -320,10 +513,11 @@ Begin
If Cmd = 'AUTHINFO' Then cmd_AUTHINFO Else If Cmd = 'AUTHINFO' Then cmd_AUTHINFO Else
If Cmd = 'GROUP' Then cmd_GROUP Else If Cmd = 'GROUP' Then cmd_GROUP Else
If Cmd = 'LIST' Then cmd_LIST Else If Cmd = 'LIST' Then cmd_LIST Else
If Cmd = 'POST' Then cmd_POST Else
If Cmd = 'QUIT' Then Break Else If Cmd = 'QUIT' Then Break Else
If Cmd = 'XOVER' Then cmd_XOVER Else If Cmd = 'XOVER' Then cmd_XOVER Else
ClientWriteLine(re_Unknown); ClientWriteLine(re_Unknown);
Until Terminated; Until Terminated or EndSession;
If Not Terminated Then ClientWriteLine(re_Goodbye); If Not Terminated Then ClientWriteLine(re_Goodbye);
End; End;