Unit MIS_Client_NNTP; {$I M_OPS.PAS} // RFC 977 Interface Uses SysUtils, m_io_Base, m_io_Sockets, m_Strings, m_FileIO, m_DateTime, MIS_Server, MIS_NodeData, MIS_Common, BBS_Records; Function CreateNNTP (Owner: TServerManager; Config: RecConfig; ND: TNodeData; CliSock: TIOSocket) : TServerClient; Type TNNTPServer = Class(TServerClient) Server : TServerManager; UserName : String[30]; LoggedIn : Boolean; Cmd : String; Data : String; User : RecUser; UserPos : LongInt; MBase : RecMessageBase; MBasePos : LongInt; CurArticle : LongInt; EndSession : Boolean; Constructor Create (Owner: TServerManager; CliSock: TIOSocket); Procedure Execute; Override; Destructor Destroy; Override; Procedure ClientWriteLine (Str: String); Procedure ResetSession; Function NNTPDate (DateStr, TimeStr: String) : String; Procedure cmd_ARTICLE; Procedure cmd_AUTHINFO; Procedure cmd_GROUP; Procedure cmd_LIST; Procedure cmd_POST; Procedure cmd_XOVER; End; Implementation Uses Dos, Classes, bbs_MsgBase_ABS, bbs_MsgBase_JAM, bbs_MsgBase_Squish; Const FileReadBuffer = 8 * 1024; HackThreshold = 10000; re_Greeting = '200 Mystic BBS NNTP server ready'; re_Goodbye = '205 Goodbye'; re_ListFollows = '215 List follows'; re_AuthOK = '281 Authentication accepted'; re_AuthBad = '381 Authentication rejected'; re_AuthPass = '381 Password required'; re_AuthReq = '450 Auth required'; re_AuthSync = '482 Bad Authentication sequence'; re_Unknown = '500 Unknown command'; re_UnknownOption = '501 Unknown option'; Function CreateNNTP (Owner: TServerManager; Config: RecConfig; ND: TNodeData; CliSock: TIOSocket) : TServerClient; Begin Result := TNNTPServer.Create(Owner, CliSock); End; Constructor TNNTPServer.Create (Owner: TServerManager; CliSock: TIOSocket); Begin Inherited Create(Owner, CliSock); Server := Owner; End; Procedure TNNTPServer.ClientWriteLine (Str: String); Begin Server.Status('S:' + Str); Client.WriteLine(Str); End; Function TNNTPServer.NNTPDate (DateStr, TimeStr: String) : String; Var TimeStamp : LongInt; TimeZone : String; Month : Byte; Year : Integer; Begin TimeStamp := DateStr2Dos(DateStr); TimeZone := GetENV('TZ'); If TimeZone = '' Then TimeZone := 'GMT'; Month := strS2I(Copy(DateStr, 1, 2)); Year := strS2I(Copy(DateStr, 7, 2)); If Year < 80 Then Inc(Year, 2000) Else Inc(Year, 1900); Result := DayString[DayOfWeek(TimeStamp)] + ', ' + Copy(DateStr, 4, 2) + ' ' + MonthString[Month] + ' ' + strI2S(Year) + ' ' + TimeStr + ':00 ' + TimeZone; End; Procedure TNNTPServer.ResetSession; Begin LoggedIn := False; UserName := ''; UserPos := -1; MBasePos := -1; CurArticle := 0; EndSession := False; End; Procedure TNNTPServer.cmd_AUTHINFO; Var NewCmd : String; NewData : String; Begin NewCmd := strUpper(strWordGet(1, Data, ' ')); NewData := Copy(Data, Pos(' ', Data) + 1, 255); If NewCmd = 'USER' Then Begin If SearchForUser(NewData, User, UserPos) Then Begin ClientWriteLine(re_AuthPass); UserName := NewData; End Else ClientWriteLine(re_AuthBad); End Else If NewCmd = 'PASS' Then Begin If UserPos = -1 Then ClientWriteLine(re_AuthSync) Else If strUpper(NewData) = User.Password Then Begin ClientWriteLine(re_AuthOK); LoggedIn := True; End Else ClientWriteLine(re_AuthBad); End Else ClientWriteLine(re_UnknownOption); If LoggedIn Then Server.Status('Logged in as ' + UserName); End; Procedure TNNTPServer.cmd_GROUP; Var MBaseFile : TFileBuffer; TempBase : RecMessageBase; MsgBase : PMsgBaseABS; Active : LongInt = 0; Low : LongInt = 0; High : LongInt = 0; Found : Boolean = False; Begin If Not LoggedIn Then Begin ClientWriteLine(re_AuthReq); Exit; End; MBaseFile := TFileBuffer.Create(FileReadBuffer); If MBaseFile.OpenStream (bbsConfig.DataPath + 'mbases.dat', SizeOf(TempBase), fmOpen, fmRWDN) Then Begin MBaseFile.ReadRecord (TempBase); While Not MBaseFile.EOF Do Begin MBaseFile.ReadRecord (TempBase); If (TempBase.NewsName = Data) and CheckAccess(User, True, TempBase.ReadACS) Then Begin Found := True; Case TempBase.BaseType of 0 : MsgBase := New(PMsgBaseJAM, Init); 1 : MsgBase := New(PMsgBaseSquish, Init); End; MsgBase^.SetMsgPath (TempBase.Path + TempBase.FileName); MsgBase^.SetTempFile (TempPath + 'msgbuf.'); If MsgBase^.OpenMsgBase Then Begin Low := 1; High := MsgBase^.GetHighMsgNum; Active := MsgBase^.NumberOfMsgs; End; Dispose (MsgBase, Done); MBase := TempBase; MBasePos := MBaseFile.FilePosRecord; CurArticle := 0; // does GROUP reset cur article? find out ClientWriteLine('211 ' + strI2S(Active) + ' ' + strI2S(Low) + ' ' + strI2S(High) + ' ' + TempBase.NewsName); Break; End; End; End; MBaseFile.Free; If Not Found Then ClientWriteLine('411 No such newsgroup'); End; Procedure TNNTPServer.cmd_LIST; Var MBaseFile : TFileBuffer; TempBase : RecMessageBase; MsgBase : PMsgBaseABS; LowMessage : LongInt; HighMessage : LongInt; PostAbility : Char; Begin If Not LoggedIn Then Begin ClientWriteLine(re_AuthReq); Exit; End; ClientWriteLine(re_ListFollows); If Data = 'OVERVIEW.FMT' Then Begin ClientWriteLine ('Subject:'); ClientWriteLine ('From:'); ClientWriteLine ('Date:'); ClientWriteLine ('Message-ID:'); ClientWriteLine ('References:'); ClientWriteLine ('Bytes:'); ClientWriteLine ('Lines:'); ClientWriteLine ('.'); // find this in RFC to make sure this website isnt wrong Exit; End; MBaseFile := TFileBuffer.Create(FileReadBuffer); If MBaseFile.OpenStream (bbsConfig.DataPath + 'mbases.dat', SizeOf(TempBase), fmOpen, fmRWDN) Then Begin MBaseFile.ReadRecord (TempBase); While Not MBaseFile.EOF Do Begin MBaseFile.ReadRecord (TempBase); If TempBase.NewsName = '' Then Continue; If CheckAccess(User, True, TempBase.ListACS) Then Begin LowMessage := 0; HighMessage := 0; Case CheckAccess(User, True, TempBase.PostACS) of False : PostAbility := 'n'; True : PostAbility := 'y'; End; Case TempBase.BaseType of 0 : MsgBase := New(PMsgBaseJAM, Init); 1 : MsgBase := New(PMsgBaseSquish, Init); End; MsgBase^.SetMsgPath (TempBase.Path + TempBase.FileName); MsgBase^.SetTempFile (TempPath + 'msgbuf.'); If MsgBase^.OpenMsgBase Then Begin LowMessage := 1; HighMessage := MsgBase^.GetHighActiveMsgNum; End; Dispose (MsgBase, Done); ClientWriteLine (TempBase.NewsName + ' ' + strI2S(LowMessage) + ' ' + strI2S(HighMessage) + ' ' + PostAbility); End; End; End; MBaseFile.Free; ClientWriteLine('.'); 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 .'); 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.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); // set tmpbuf 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 Article posted ok'); End; *) Procedure TNNTPServer.cmd_POST; Var MsgBase : PMsgBaseABS; MBaseFile : File of RecMessageBase; 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 .'); 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.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; Assign (MBaseFile, bbsConfig.DataPath + 'mbases.dat'); If ioReset(MBaseFile, SizeOf(RecMessageBase), fmRWDN) Then Begin ioRead (MBaseFile, TempBase); While Not EOF(MBaseFile) Do Begin ioRead (MBaseFile, TempBase); If TempBase.NewsName = Newsgroup Then Begin Found := True; Break; End; End; End; Close (MBaseFile); 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); MsgBase^.SetTempFile (TempPath + 'msgbuf.'); 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 Article posted ok'); End; Procedure TNNTPServer.cmd_ARTICLE; Var ArticleNum : LongInt = 0; Found : Boolean = False; MsgBase : PMsgBaseABS; Str : String; Begin If Not LoggedIn Then Begin ClientWriteLine(re_AuthReq); Exit; End; If MBasePos = -1 Then Begin ClientWriteLine('412 No newsgroup selected'); Exit; End; ArticleNum := strS2I(Data); Case MBase.BaseType of 0 : MsgBase := New(PMsgBaseJAM, Init); 1 : MsgBase := New(PMsgBaseSquish, Init); End; MsgBase^.SetMsgPath (MBase.Path + MBase.FileName); MsgBase^.SetTempFile (TempPath + 'msgbuf.'); If Not MsgBase^.OpenMsgBase Then Begin ClientWriteLine('423 No such article'); Dispose (MsgBase, Done); Exit; End; MsgBase^.SeekFirst(ArticleNum); Found := MsgBase^.SeekFound; If Found Then Begin MsgBase^.MsgStartUp; Found := MsgBase^.GetMsgNum = ArticleNum; End; If Not Found Then Begin ClientWriteLine('423 No such article'); Dispose (MsgBase, Done); Exit; End; MsgBase^.MsgTxtStartUp; ClientWriteLine ('220 ' + strI2S(ArticleNum) + ' <' + strI2S(ArticleNum) + '> article retrieved - head and body follow'); // ClientWriteLine('220 0 ' + strI2S(ArticleNum)); Client.WriteLine('From: ' + MsgBase^.GetFrom); Client.WriteLine('Newsgroups: ' + MBase.NewsName); Client.WriteLine('Subject: ' + MsgBase^.GetSubj); Client.WriteLine('Date: ' + NNTPDate(MsgBase^.GetDate, MsgBase^.GetTime)); Client.WriteLine(''); While Not MsgBase^.EOM Do Begin Str := MsgBase^.GetString(79); If Str[1] = ^A Then Continue; Client.WriteLine(Str); End; Client.WriteLine ('.'); Dispose (MsgBase, Done); End; Procedure TNNTPServer.cmd_XOVER; Var First : LongInt = 0; Last : LongInt = 0; Found : Boolean = False; MsgBase : PMsgBaseABS; MsgText : TStringList; Str : String; Begin If Not LoggedIn Then Begin ClientWriteLine(re_AuthReq); Exit; End; If MBasePos = -1 Then Begin ClientWriteLine('412 No newsgroup selected'); Exit; End; If Pos('-', Data) > 0 Then Begin First := strS2I(strWordGet(1, Data, '-')); Last := strS2I(strWordGet(2, Data, '-')); End Else Begin First := strS2I(Data); Last := First; End; Case MBase.BaseType of 0 : MsgBase := New(PMsgBaseJAM, Init); 1 : MsgBase := New(PMsgBaseSquish, Init); End; MsgBase^.SetMsgPath (MBase.Path + MBase.FileName); MsgBase^.SetTempFile (TempPath + 'msgbuf.'); If Not MsgBase^.OpenMsgBase Then Begin ClientWriteLine('420 No article(s) selected'); Dispose (MsgBase, Done); Exit; End; If Last = 0 Then Last := MsgBase^.GetHighMsgNum; MsgText := TStringList.Create; MsgBase^.SeekFirst(First); While MsgBase^.SeekFound Do Begin If Not Found Then Begin Found := True; ClientWriteLine('224 Overview information follows'); End; MsgBase^.MsgStartUp; MsgBase^.MsgTxtStartUp; MsgText.Clear; While Not MsgBase^.EOM Do Begin Str := MsgBase^.GetString(79); If Str[1] = ^A Then Continue; MsgText.Add(Str); End; Client.WriteStr(strI2S(MsgBase^.GetMsgNum) + #9); Client.WriteStr(MsgBase^.GetSubj + #9); Client.WriteStr(MsgBase^.GetFrom + #9); Client.WriteStr(NNTPDate(MsgBase^.GetDate, MsgBase^.GetTime) + #9); Client.WriteStr(strI2S(MsgBase^.GetMsgNum) + #9); //msgID Client.WriteStr(#9); //refs Client.WriteStr(strI2S(Length(MsgText.Text)) + #9); Client.WriteStr(strI2S(MsgText.Count) + #13#10); If MsgBase^.GetMsgNum >= Last Then Break; MsgBase^.SeekNext; End; Client.WriteLine('.'); MsgText.Free; Dispose (MsgBase, Done); If Not Found Then ClientWriteLine('420 No article(s) selected'); End; Procedure TNNTPServer.Execute; Var Str : String; Begin ResetSession; ClientWriteLine(re_Greeting); Repeat If Client.WaitForData(bbsConfig.inetNNTPTimeout * 1000) = 0 Then Break; If Terminated Then Exit; If Client.ReadLine(Str) = -1 Then Exit; Server.Status('C:' + Str); Cmd := strUpper(strWordGet(1, Str, ' ')); If Pos(' ', Str) > 0 Then Data := strStripB(Copy(Str, Pos(' ', Str) + 1, Length(Str)), ' ') Else Data := ''; If Cmd = 'ARTICLE' Then cmd_ARTICLE Else If Cmd = 'AUTHINFO' Then cmd_AUTHINFO Else If Cmd = 'GROUP' Then cmd_GROUP Else If Cmd = 'LIST' Then cmd_LIST Else If Cmd = 'POST' Then cmd_POST Else If Cmd = 'QUIT' Then Break Else If Cmd = 'XOVER' Then cmd_XOVER Else ClientWriteLine(re_Unknown); Until Terminated or EndSession; If Not Terminated Then ClientWriteLine(re_Goodbye); End; Destructor TNNTPServer.Destroy; Begin Inherited Destroy; End; End.