mysticbbs/mystic/mis_client_smtp.pas

344 lines
8.5 KiB
ObjectPascal

// ====================================================================
// Mystic BBS Software Copyright 1997-2013 By James Coyle
// ====================================================================
//
// This file is part of Mystic BBS.
//
// Mystic BBS is free software: you can redistribute it and/or modify
// it under the terms of the GNU General Public License as published by
// the Free Software Foundation, either version 3 of the License, or
// (at your option) any later version.
//
// Mystic BBS is distributed in the hope that it will be useful,
// but WITHOUT ANY WARRANTY; without even the implied warranty of
// MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
// GNU General Public License for more details.
//
// You should have received a copy of the GNU General Public License
// along with Mystic BBS. If not, see <http://www.gnu.org/licenses/>.
//
// ====================================================================
{$I M_OPS.PAS}
Unit MIS_Client_SMTP;
{ update e-mails post stats }
{ update bbs history }
Interface
Uses
Classes,
SysUtils,
m_io_Base,
m_io_Sockets,
m_Strings,
m_FileIO,
m_DateTime,
bbs_MsgBase_ABS,
bbs_MsgBase_JAM,
bbs_MsgBase_Squish,
MIS_Server,
MIS_NodeData,
MIS_Common,
BBS_Records,
BBS_DataBase;
Function CreateSMTP (Owner: TServerManager; Config: RecConfig; ND: TNodeData; CliSock: TIOSocket) : TServerClient;
Type
TSMTPServer = Class(TServerClient)
Server : TServerManager;
User : RecUser;
UserPos : LongInt;
Cmd : String;
Data : String;
EndSession : Boolean;
FromName : String;
FromPos : LongInt;
ToList : TStringList;
Constructor Create (Owner: TServerManager; CliSock: TIOSocket);
Procedure Execute; Override;
Destructor Destroy; Override;
Procedure ResetSession;
Function ValidateNameAndDomain (IsFrom: Boolean) : Boolean;
Procedure cmdHELO;
Procedure cmdRSET;
Procedure cmdMAIL;
Procedure cmdRCPT;
Procedure cmdDATA;
End;
Implementation
Const
SMTPHackThresh = 10000;
re_Goodbye = '221 Goodbye';
re_UnknownCmd = '502 Unknown command';
re_OK = '250 OK';
re_BadUser = '550 No such user here';
re_NeedMail = '503 Must send MAIL FROM: first';
re_NeedRcpt = '503 Must send RCPT TO: first';
re_ErrorSending = '550 Mailbox not found';
Function CreateSMTP (Owner: TServerManager; Config: RecConfig; ND: TNodeData; CliSock: TIOSocket) : TServerClient;
Begin
Result := TSMTPServer.Create(Owner, CliSock);
End;
Constructor TSMTPServer.Create (Owner: TServerManager; CliSock: TIOSocket);
Begin
Inherited Create(Owner, CliSock);
Server := Owner;
End;
Function TSMTPServer.ValidateNameAndDomain (IsFrom: Boolean) : Boolean;
Var
InName : String;
InDomain : String;
Begin
Result := False;
InName := strReplace(Copy(Data, Pos('<', Data) + 1, Pos('@', Data) - Pos('<', Data) - 1), '_', ' ');
InDomain := Copy(Data, Pos('@', Data) + 1, Pos('>', Data) - Pos('@', Data) - 1);
If IsFrom Then
Server.Status(ProcessID, 'User: ' + InName + ' Domain: ' + InDomain);
Result := SearchForUser(InName, User, UserPos, InName + '@' + InDomain);
If (InDomain <> bbsCfg.iNetDomain) and (Result = False) Then Begin
Server.Status(ProcessID, 'Refused by domain: ' + InName + '@' + InDomain);
Exit;
End;
If Not Result Then Begin
Server.Status(ProcessID, 'Refused by name: ' + InName + '@' + InDomain);
End;
End;
Procedure TSMTPServer.ResetSession;
Begin
UserPos := -1;
FromName := '';
FromPos := -1;
EndSession := False;
If Assigned(ToList) Then ToList.Free;
ToList := TStringList.Create;
End;
Procedure TSMTPServer.cmdHELO;
Begin
Client.WriteLine('250 ' + bbsCfg.inetDomain);
End;
Procedure TSMTPServer.cmdRSET;
Begin
ResetSession;
Client.WriteLine(re_OK);
End;
Procedure TSMTPServer.cmdMAIL;
Begin
If ValidateNameAndDomain(True) Then Begin
FromName := User.Handle;
Client.WriteLine (re_OK)
End Else
Client.WriteLine (re_BadUser);
End;
Procedure TSMTPServer.cmdRCPT;
Begin
If FromName = '' Then Begin
Client.WriteLine (re_NeedMail);
Exit;
End;
If ValidateNameAndDomain(False) Then Begin
ToList.Add(User.Handle);
Client.WriteLine (re_OK);
End Else
Client.WriteLine (re_BadUser);
End;
Procedure TSMTPServer.cmdDATA;
Var
InData : String;
HackCount : LongInt;
MBaseFile : File of RecMessageBase;
MBase : RecMessageBase;
MsgBase : PMsgBaseABS;
MsgText : TStringList;
MsgSubject : String;
MsgLoop : LongInt;
Count : LongInt;
Count2 : LongInt;
Str : String;
Begin
If FromName = '' Then Begin
Client.WriteLine (re_NeedMail);
Exit;
End;
If ToList.Count = 0 Then Begin
Client.WriteLine (re_NeedRcpt);
Exit;
End;
Client.WriteLine ('354 Start mail input; end with <CRLF>.<CRLF>');
MsgText := TStringList.Create;
Repeat
Client.ReadLine(InData);
If InData = '.' Then Break;
If MsgText.Count >= mysMaxMsgLines Then Begin
HackCount := 0;
While Not Terminated And (InData <> '.') Do Begin
// todo: what happens if they never send an EOL... could still flood
Client.ReadLine(InData);
Inc (HackCount);
If HackCount >= SMTPHackThresh Then Begin
EndSession := True; // someone is being a douchebag
Server.Status(ProcessID, 'Flood attempt from ' + FromName + ' (' + Client.PeerIP + '); Goodbye');
MsgText.Free;
Exit;
End;
End;
Break;
End;
MsgText.Add(InData);
Until False;
Assign (MBaseFile, bbsCfg.DataPath + 'mbases.dat');
ioReset (MBaseFile, SizeOf(RecMessageBase), fmRWDN);
ioRead (MBaseFile, MBase);
Close (MBaseFile);
If Not MBaseOpenCreate (MsgBase, MBase, TempPath) Then Begin
MsgText.Free;
Client.WriteLine(re_ErrorSending);
Exit;
End;
MsgSubject := '';
Count := 0;
While Count < MsgText.Count Do Begin
If Pos('Subject:', MsgText.Strings[Count]) > 0 Then
MsgSubject := Copy(MsgText.Strings[Count], 10, Length(MsgText.Strings[Count]))
Else
If MsgText.Strings[Count] = '' Then Begin
While (MsgText.Strings[Count] = '') And (Count < MsgText.Count) Do Inc(Count);
Break;
End;
Inc (Count);
End;
If Count = MsgText.Count Then Begin
Client.WriteLine(re_ErrorSending);
MsgText.Free;
Exit;
End;
For MsgLoop := 0 To ToList.Count - 1 Do Begin
Server.Status(ProcessID, 'Sending mail from ' + FromName + ' to ' + ToList.Strings[MsgLoop]);
MsgBase^.StartNewMsg;
MsgBase^.SetLocal (True);
MsgBase^.SetMailType (mmtNormal);
MsgBase^.SetPriv (True);
MsgBase^.SetDate (FormatDateTime('mm/dd/yy', Now));
MsgBase^.SetTime (FormatDateTime('hh:nn', Now));
MsgBase^.SetFrom (FromName);
MsgBase^.SetTo (ToList.Strings[MsgLoop]);
MsgBase^.SetSubj (MsgSubject);
For Count2 := Count to MsgText.Count - 1 Do Begin
Str := MsgText.Strings[Count2];
If Length(Str) > 79 Then Str[0] := #79;
MsgBase^.DoStringLn(Str);
End;
MsgBase^.WriteMsg;
End;
MsgBase^.CloseMsgBase;
Dispose (MsgBase, Done);
Client.WriteLine(re_OK);
End;
Procedure TSMTPServer.Execute;
Var
Str : String;
Begin
ResetSession;
Client.WriteLine('220 ' + bbsCfg.iNetDomain + ' Mystic SMTP Ready');
Repeat
If Client.WaitForData(bbsCfg.inetSMTPTimeout * 1000) = 0 Then Break;
If Terminated Then Exit;
If Client.ReadLine(Str) = -1 Then Exit;
Cmd := strUpper(strWordGet(1, Str, ' '));
If Pos(' ', Str) > 0 Then
Data := strStripB(Copy(Str, Pos(' ', Str) + 1, Length(Str)), ' ')
Else
Data := '';
If Cmd = 'DATA' Then cmdDATA Else
If Cmd = 'EHLO' Then cmdHELO Else
If Cmd = 'HELO' Then cmdHELO Else
If Cmd = 'MAIL' Then cmdMAIL Else
If Cmd = 'NOOP' Then Client.WriteLine(re_OK) Else
If Cmd = 'RCPT' Then cmdRCPT Else
If Cmd = 'RSET' Then cmdRSET Else
If Cmd = 'QUIT' Then Break Else
Client.WriteLine(re_UnknownCmd);
Until Terminated or EndSession;
If Not Terminated And Not EndSession Then Client.WriteLine(re_Goodbye);
End;
Destructor TSMTPServer.Destroy;
Begin
If Assigned(ToList) Then ToList.Free;
Inherited Destroy;
End;
End.