www.pudn.com > EmailServer.zip > Pop3Server.pas
unit Pop3Server;
(******************************************************************************)
(* *)
(* Pop3 Server Objects *)
(* Part of Hermes SMTP/POP3 Server. *)
(* Copyright(C) 2000 by Alexander J. Fanti, All Rights Reserver Worldwide. *)
(* *)
(* Contains: TPop3Server, TPop3Connection *)
(* *)
(* Created January 11, 2000 by Alexander J. Fanti. See License.txt *)
(* *)
(* Depends on: DataU1 (Pop3 User Information, Pop3 Mail Information Object) *)
(* *)
(* Also Uses: WSocket, MD5 (Francois Piette Internet Component Suite) *)
(* *)
(* Used by: Main *)
(* *)
(* Implememtation Note: No support for UIDL. This requires persistant state *)
(* info for messages I don't want *)
(* to store *)
(* APOP support depends on Francois' MD5 code. *)
(* Refer to RFC 1725 *)
(* Description: *)
(* TPop3Server - This server object manages the Pop3 connections, controls *)
(* listening for connections, and accepts them. *)
(* TPop3Connection - The Connection object is the real server. It handles *)
(* the individual Pop3 connection, and any requests by the *)
(* connected user. *)
(* *)
(* Revisions: 1/12/2000 AJF Commented *)
(* Revisions: 1/25/2000 AJF Commented *)
(* *)
(******************************************************************************)
interface
uses Classes, SysUtils, FileCtrl, ExtCtrls, INIFiles, Messages, Windows,
WSocket, MD5, {Francois Components, MD5 for APOP only}
DataU1;
const
CRLF = #13 + #10;
WM_FREECONNECTION = WM_USER + 100;
type
TPop3Connection = class;
TPop3Server_ErrorCode = (pec_Bad_Mailbox_Path, pec_CantListen,
pec_SocketError);
TPop3Server_StateChange = procedure(Sender : TObject; Active : Boolean;
OpenConnections : Longint) of Object;
TPop3Server_StatusUpdate = procedure(Sender : TObject; Status : String;
Level : Integer) of Object;
TPop3Server_Error = procedure(Sender : TObject;
ErrorCode : TPop3Server_ErrorCode) of Object;
TPop3Server = class(TWHComponent)
private
FSocket : TWSocket; // Socket for Listening for Pop3 requests
ConnectionList : TList; // List of TPop3Connection objects currently open
// Bind address, Port, server name, mailboxpath and other Pop3 server
// settings come straight from global INI object
FActive : Boolean; // True when server is listening
FOnStateChange : TPop3Server_StateChange; // Event Ptr for OnChangeState
FOnStatusUpdate : TPop3Server_StatusUpdate; // Event Ptr for StatusUpdate
FOnError : TPop3Server_Error; // Event Ptr for Server Error
// We use this to let the connection object tell us when it's finished
// so we can free it!
procedure WindowsMessage(Sender : TObject; Msg: TMessage);
function GetActive : Boolean; // Read if server's active
function GetConnectionCount : Longint; // Read Pop3Connection Count
// Socket procedures for Listening socket
procedure SocketSessionAvailable(Sender: TObject; Error: Word);
procedure SocketChangeState(Sender: TObject;
OldState, NewState: TSocketState);
procedure SocketSessionClosed(Sender: TObject; Error: Word);
procedure SocketError(Sender: TObject);
procedure SocketBgException(Sender: TObject; E: Exception;
var CanClose: Boolean);
// Triggered when TPop3Connection fires a StatusUpdate event
procedure Pop3ConnectionStatusUpdate(Sender : TObject; Status : String;
Level : Integer);
procedure CloseConnection(AConnection : TPop3Connection);
procedure CloseAllConnections;
public
constructor Create(AOwner : TComponent); Override;
destructor Destroy; Override;
// Methods
procedure Listen; // Listen for Pop3 Connections
procedure Stop; // Stop listening for Pop3 Connections
procedure Shutdown; // Stop listening and close all open Pop3 Connections
// Used by TPop3Connection to see if "MailBox Locked" meaning someone is
// already talking to the mailbox (that user's logged in from elsewhere)
function IsUserAlreadyConnected(OpenConn : TPop3Connection;
User : String) : Boolean;
procedure ConnectionInactivityTimeout(Minutes : Integer);
// Check all connections for inactivity
// Properties
property Active : Boolean read GetActive;
property Count : Longint read GetConnectionCount;
// Events
property OnStateChange : TPop3Server_StateChange // Fired on Server State
read FOnStateChange write FOnStateChange; // Change (Active)
property OnStatusUpdate : TPop3Server_StatusUpdate // Fired on Status
read FOnStatusUpdate write FOnStatusUpdate; // Update
property OnError : TPop3Server_Error // Fired on Server Error
read FOnError write FOnError;
end;
TPop3Connection_State = (pcs_AUTHENTICATION_WAITUSER,
pcs_AUTHENTICATION_WAITPASS,
pcs_TRANSACTION, pcs_UPDATE);
TPop3Connection_StatusUpdate = procedure(Sender : TObject; Status : String;
Level : Integer) of Object;
TPop3Connection = class(TComponent)
private
FServer : TPop3Server;
FSocket : TWSocket; // Socket for Talking to Pop3 User
FBufferStr : String; // To buffer commands from Socket
FState : TPop3Connection_State; // State of Pop3 Connection
FLastActivity : TDateTime; // Time of last activity (for timeout)
FServerMD5ID : String; // The String send on connect (for APOP)
FUserID : String; // User ID (of user logged in)
FUserInfo : TPop3UserInformation; // Pop3 User Information (like password)
// See DataU1
FMailInfo : TPop3MailInformation; // User's Pop3 Mail information (count...)
// See DataU1
FOnStatusUpdate : TPop3Connection_StatusUpdate; // Event Ptr for StatusUpd.
procedure StatusUpdate(Status : String; Level : Integer);
// Used internally to Trigger Status Update
procedure ProcessRequest(UserRequest : String); // Process Pop3 Request
// Socket Procedures for Connected Socket
procedure SocketDataAvailable(Sender: TObject; Error: Word);
procedure SocketDataSent(Sender: TObject; Error: Word);
procedure SocketSessionClosed(Sender: TObject; Error: Word);
procedure SocketError(Sender: TObject);
procedure SocketBgException(Sender: TObject; E: Exception;
var CanClose: Boolean);
procedure Close; // Close connection and terminate
public
constructor Create(AOwner : TPop3Server);
destructor Destroy; Override;
procedure Accept(SocketHandle : Integer); // Pop3 Connection
property User : String read FUserID; // Connected User
property LastActivity : TDateTime read FLastActivity;
property OnStatusUpdate : TPop3Connection_StatusUpdate // Fired on Status
read FOnStatusUpdate write FOnStatusUpdate; // Update
end;
implementation
(******************************************************************************)
(* *)
(* START POP3 Server Object *)
(* *)
(* This Object listens for connections, accepts them and tracks them. It *)
(* also reports on them, and can drop them. *)
(* *)
(******************************************************************************)
constructor TPop3Server.Create(AOwner : TComponent);
begin
inherited Create(AOwner);
OnWindowsMessage := WindowsMessage;
// Initialize variables
ConnectionList := TList.Create;
FActive := False;
// Listening Socket Create and Setup
FSocket := TWSocket.Create(Self);
FSocket.OnSessionAvailable := SocketSessionAvailable;
FSocket.OnChangeState := SocketChangeState;
FSocket.OnSessionClosed := SocketSessionClosed;
FSocket.OnError := SocketError;
FSocket.OnBgException := SocketBgException;
end;
procedure TPop3Server.WindowsMessage(Sender : TObject; Msg: TMessage);
begin
if Msg.Msg = WM_FREECONNECTION then
CloseConnection(TPop3Connection(Msg.WParam));
end;
destructor TPop3Server.Destroy;
begin
if Assigned(FSocket) then begin
FSocket.Destroy;
FSocket := nil;
end;
CloseAllConnections;
ConnectionList.Free;
inherited Destroy;
end;
procedure TPop3Server.CloseConnection(AConnection : TPop3Connection);
var
x : Longint;
Connection : TPop3Connection;
begin
for x := ConnectionList.Count -1 downto 0 do begin
Connection := TPop3Connection(ConnectionList[x]);
if Connection = AConnection then begin
ConnectionList.Delete(x);
AConnection.Free;
if Assigned(FOnStateChange) then
OnStateChange(Self, FSocket.State = wsListening, ConnectionList.Count);
end;
end;
end;
procedure TPop3Server.CloseAllConnections;
var
x : Longint;
Connection : TPop3Connection;
begin
for x := ConnectionList.Count -1 downto 0 do begin
Connection := TPop3Connection(ConnectionList[x]);
CloseConnection(Connection);
end;
end;
function TPop3Server.GetActive : Boolean;
begin
FActive := FSocket.State = wsListening;
Result := FActive;
end;
function TPop3Server.GetConnectionCount : Longint;
begin
Result := ConnectionList.Count;
end;
function TPop3Server.IsUserAlreadyConnected(OpenConn : TPop3Connection;
User : String) : Boolean;
var
x : Longint;
Connection : TPop3Connection;
begin
Result := False;
// See if there's a connection (other than the requesting one) for this user
// This is how we determine if the mailbox is "locked"
for x := ConnectionList.Count -1 downto 0 do begin
Connection := TPop3Connection(ConnectionList[x]);
if (LowerCase(Connection.User) = LowerCase(User)) and
(Connection <> OpenConn) then Result := True;
end;
end;
procedure TPop3Server.ConnectionInactivityTimeout(Minutes : Integer);
const
HOUR = 0.04167;
MINUTE = 0.00069;
var
x : Longint;
Connection : TPop3Connection;
DT : TDateTime;
begin
// See if there's a connection that hasn't been active for a while
if Minutes > 0 then begin
for x := ConnectionList.Count -1 downto 0 do begin
Connection := TPop3Connection(ConnectionList[x]);
DT := Now - Connection.LastActivity;
if DT > (Minutes * MINUTE) then begin
if Assigned(FOnStatusUpdate) then
OnStatusUpdate(Self, ' ' +
'Closing due to inactivity (' + IntToStr(Minutes) + ' minutes).',
STAT_SERVERERROR);
CloseConnection(Connection);
end;
end;
end;
end;
procedure TPop3Server.Listen;
begin
FSocket.Close;
FSocket.Addr := INI.Pop3_BindAddress;
FSocket.Port := IntToStr(INI.Pop3_Port);
FSocket.Proto := 'TCP';
FSocket.Listen;
end;
procedure TPop3Server.Stop;
begin
FSocket.Close;
end;
procedure TPop3Server.Shutdown;
begin
Stop; // Stop listening for new connections
CloseAllConnections;
end;
procedure TPop3Server.SocketSessionAvailable(Sender: TObject; Error: Word);
var
Connection : TPop3Connection;
begin
// Pop3 Seccion Request
// Create a new Pop3 Connection and accept the request to it...
Connection := TPop3Connection.Create(Self);
Connection.OnStatusUpdate := Pop3ConnectionStatusUpdate;
ConnectionList.Add(Connection); // Keep track of the connection (add to list)
if Assigned(FOnStateChange) then
OnStateChange(Self, FSocket.State = wsListening, ConnectionList.Count);
Connection.Accept(FSocket.Accept);
end;
procedure TPop3Server.SocketChangeState(Sender: TObject;
OldState, NewState: TSocketState);
var
OldActive : Boolean;
begin
OldActive := FActive;
FActive := FSocket.State = wsListening;
if (OldActive <> FActive) and Assigned(FOnStateChange) then
OnStateChange(Self, FSocket.State = wsListening, ConnectionList.Count);
end;
procedure TPop3Server.SocketSessionClosed(Sender: TObject; Error: Word);
begin
if Assigned(FOnStateChange) then
OnStateChange(Self, FSocket.State = wsListening, ConnectionList.Count);
end;
procedure TPop3Server.SocketError(Sender: TObject);
var
Error : Integer;
begin
// Socket error. This could be because the listening socket can't bind to
// the port (10048) or something else. In fact, bind failure is so common,
// I'll treat it seperately.
Error := FSocket.LastError;
if Error = 10048 then begin // Unable to bind to port
if Assigned(FOnStatusUpdate) then
OnStatusUpdate(Self, 'Can''t Bind to ' + INI.Pop3_BindAddress +':' +
IntToStr(INI.Pop3_Port), STAT_SERVERERROR);
if Assigned(FOnError) then OnError(Self, pec_CantListen);
end else begin // Other Error
if Assigned(FOnStatusUpdate) then
OnStatusUpdate(Self, 'Error #' + IntToStr(FSocket.LastError),
STAT_SERVERERROR);
if Assigned(FOnError) then OnError(Self, pec_SocketError);
end;
end;
procedure TPop3Server.SocketBgException(Sender: TObject; E: Exception;
var CanClose: Boolean);
begin
// Critical Socket Error...
// This is because something caused an Exception during the socket's
// processing while it was in an event handler.
// If the program is good, this will never happen... but...
CanClose := False;
if Assigned(FOnStatusUpdate) then
OnStatusUpdate(Self, 'Unknown BG Exception', STAT_CRITICALERROR);
if Assigned(FOnError) then OnError(Self, pec_SocketError);
end;
procedure TPop3Server.Pop3ConnectionStatusUpdate(Sender : TObject;
Status : String;
Level : Integer);
begin
// the Pop3Connection has something to report... I'll pass it on,
// but add where I got it from...
if Assigned(FOnStatusUpdate) then
OnStatusUpdate(Self, ' ' +
Status, Level);
end;
(******************************************************************************)
(* *)
(* STOP POP3 Server Object *)
(* *)
(******************************************************************************)
(******************************************************************************)
(* *)
(* START POP3 Connection Object *)
(* *)
(* The actual Pop3 server protocols are implemented here. This is the real *)
(* Pop3 server code. We try to handle all Pop3 requests here and act on *)
(* whatever we get. *)
(* *)
(* Note: not all commands are implemented. *)
(* *)
(******************************************************************************)
constructor TPop3Connection.Create(AOwner : TPop3Server);
begin
inherited Create(AOwner);
FServer := TPop3Server(AOwner);
// Initialize variables
FLastActivity := Now;
FState := pcs_AUTHENTICATION_WAITUSER;
FServerMD5ID := '';
FUserID := '';
FUserInfo := TPop3UserInformation.Create;
FMailInfo := TPop3MailInformation.Create;
// Connecting Socket Create and Setup
FSocket := TWSocket.Create(Self);
FSocket.OnDataAvailable := SocketDataAvailable;
FSocket.OnDataSent := SocketDataSent;
FSocket.OnSessionClosed := SocketSessionClosed;
FSocket.OnError := SocketError;
FSocket.OnBgException := SocketBgException;
FBufferStr := '';
end;
destructor TPop3Connection.Destroy;
begin
FUserInfo.Free;
FMailInfo.Free;
if Assigned(FSocket) then begin
FSocket.Destroy;
FSocket := nil;
end;
inherited Destroy;
end;
procedure TPop3Connection.StatusUpdate(Status : String; Level : Integer);
begin
if Assigned(FOnStatusUpdate) then OnStatusUpdate(Self, Status, Level);
end;
procedure TPop3Connection.Accept(SocketHandle : Integer);
begin
FSocket.Dup(SocketHandle);
StatusUpdate('Accepted', STAT_CONNECTIONEVENT);
// Initialize Connection State
FState := pcs_AUTHENTICATION_WAITUSER;
if FSocket.State = wsConnected then begin
StatusUpdate('Connected', STAT_CONNECTIONEVENT);
// Determine Server Info for possible APOP command (MD5 ID)
FServerMD5ID := '<' + IntToStr(Integer(Self)) + '.' +
FloatToStr(Now) + '@' + INI.ServerName + '>';
// Send Greeting
case INI.Banner_Level of
bannerlevel_NameVersionService : FSocket.SendStr('+OK ' + 'Hermes ' + AppVersion + ' POP3 Ready. ' + FServerMD5ID + CRLF);
bannerlevel_NameService : FSocket.SendStr('+OK ' + 'Hermes POP3 Ready. ' + FServerMD5ID + CRLF);
bannerlevel_Service : FSocket.SendStr('+OK ' + 'POP3 Ready. ' + FServerMD5ID + CRLF);
else FSocket.SendStr('+OK ' + 'Hermes POP3 Ready. ' + FServerMD5ID + CRLF);
end;
end else begin
//
// DEBUG
//
// Is there ever a time we could accept the connection and then not be
// connected? If this happened, we assume the SessionClosed event would
// fire, thereby closing our connection and object.
//
// This is also seen in the TSmtpConnection Object
end;
end;
procedure TPop3Connection.Close;
begin
// We want to close.
// If the socket is open, close it... if not,
// send the message that will free this connection object
if FSocket.State <> wsClosed then FSocket.Close
else PostMessage(FServer.Handle, WM_FREECONNECTION, Integer(Self), 0);
end;
// procedure SocketSessionConnected(Sender: TObject; Error: Word);
// This is not called when we accept a connection
procedure TPop3Connection.SocketDataAvailable(Sender: TObject; Error: Word);
var
x : Longint;
len : Integer; // Length of data accepted from the socket
Buffer : Array[0..1023] of Char; // buffer of data we'll accept from socket
// we add this data to the socket's command
// buffer (FBufferStr) and then parse it
// for CRLF to seperate out commands we
// need to act on.
UserRequest : String; // the command we got from the buffer
begin
// Data is available from the socket for processing.
// we'll receive the data, and buffer it until we get a CRLF,
// indicating the end of some sort of command from the client
len := FSocket.Receive(@Buffer[0], 1024);
FLastActivity := Now; // We have activity...
// add to Command Buffer (FBufferStr)
for x := 0 to len -1 do FBufferStr := FBufferStr + Buffer[x];
// Process buffer (look for CRLF) and process each command
while Pos(CRLF, FBufferStr) > 0 do begin
UserRequest := Copy(FBufferStr, 1, Pos(CRLF, FBufferStr) -1);
FBufferStr := Copy(FBufferStr, Pos(CRLF, FBufferStr) +2,
Length(FBufferStr));
// Process a command
ProcessRequest(UserRequest);
end;
end;
procedure TPop3Connection.SocketDataSent(Sender: TObject; Error: Word);
begin
FLastActivity := Now; // We have activity...
end;
procedure TPop3Connection.ProcessRequest(UserRequest : String);
var
Command : String; // User Command
Parameter1, Parameter2 : String; // Possible Command Parameters
Para_MessageID, Para_LineCount : Longint; // Parameters specific
Para_UserName, Para_Password, Para_Digest : String; // to given commands
x, y : Longint;
UserValid, PasswordValid : Boolean; // Is the requested user / pwd valid?
HeaderBreak : Longint; // The Index of the blank line of the header (for TOP)
MailItem : PPop3MailEntry; // Pointer to a mail item (see DataU1)
SL : TStringList; // Temporary string list for holding message to send
begin
if UserRequest <> '' then begin
// Seperate out command from parameters to command
Command := UpperCase(Trim(UserRequest));
Parameter1 := '';
if Pos(' ', UserRequest) > 0 then begin
Command := UpperCase(Trim(Copy(UserRequest, 1, Pos(' ', UserRequest))));
Parameter1 := Trim(Copy(UserRequest, Pos(' ', UserRequest),
Length(UserRequest)));
end;
StatusUpdate('Command: ' + Command, STAT_CONNECTIONEVENT);
if (Command = 'USER') and
(FState = pcs_AUTHENTICATION_WAITUSER) and
(FSocket.State = wsConnected) then begin
// User wants to log in... giving us User ID
// Determine User ID
Para_UserName := Parameter1;
UserValid := INI.User_Exists(Para_UserName);
// Do we create user on demand?
if (not UserValid) and (INI.Pop3_CreateUserOnDemand) then
if INI.User_Create(Para_UserName) then UserValid := True;
if UserValid then begin
FUserID := Para_UserName;
// Fetch user information (password and whatnot)
FUserInfo.LoadFromFile(FUserID);
FState := pcs_AUTHENTICATION_WAITPASS;
FSocket.SendStr('+OK Send Password' + CRLF);
StatusUpdate('User ' + FUserID + ' OK', STAT_COMMANDEVENT);
end else begin
FSocket.SendStr('-ERR Unknown User' + CRLF);
StatusUpdate('User ' + FUserID + ' BAD', STAT_COMMANDERROR);
end;
end else
if (Command = 'PASS') and
(FState = pcs_AUTHENTICATION_WAITPASS) and
(FSocket.State = wsConnected) then begin
// User whats to finish logging in... give us password
// Determine user password
Para_Password := Parameter1;
PasswordValid := (FUserInfo.Password = Para_Password) and
(FUserInfo.Password <> '');
// Do we create password on demand?
if (not PasswordValid) and
(INI.Pop3_CreateUserPasswordOnDemand) then begin
FUserInfo.Password := Para_Password;
FUserInfo.SaveToFile(FUserID);
PasswordValid := True;
end;
if PasswordValid then begin
// Be sure we havn't got another connection to this user already!
if FServer.IsUserAlreadyConnected(Self, FUserID) then begin
// Mailbox locked by same user on different connection
FState := pcs_AUTHENTICATION_WAITUSER;
FSocket.SendStr('-ERR Cannot Lock Mailbox' + CRLF);
StatusUpdate('User Password OK, but mailbox locked.',
STAT_COMMANDERROR);
end else begin
// Mailbox available, Get Mailbox information
FState := pcs_TRANSACTION;
FMailInfo.ReadFolder(FUserID);
FSocket.SendStr('+OK ' + IntToStr(FMailInfo.Count) + ' ' +
IntToStr(FMailInfo.ByteCount) + CRLF);
StatusUpdate('User Password OK', STAT_COMMANDEVENT);
end;
end else begin
// User Password not good
FState := pcs_AUTHENTICATION_WAITUSER;
FSocket.SendStr('-ERR Password Invalid' + CRLF);
StatusUpdate('User Password BAD', STAT_COMMANDERROR);
end;
end else
if (Command = 'APOP') and // Optional
(FState = pcs_AUTHENTICATION_WAITUSER) and
(FSocket.State = wsConnected) then begin
// User wants to login with APOP
// Get User ID and Digest
Para_UserName := Parameter1;
Para_Digest := '';
if Pos(' ', Parameter1) > 0 then begin
Para_UserName := UpperCase(Trim(Copy(Parameter1, 1,
Pos(' ', Parameter1))));
Para_Digest := Trim(Copy(Parameter1, Pos(' ', Parameter1),
Length(Parameter1)));
end;
if (Para_UserName <> '') and (Para_Digest <> '') then begin
UserValid := DirectoryExists(INI.MailBoxPath + '\' + Para_UserName);
if UserValid then begin
FUserID := LowerCase(Para_UserName);
// Can't create a user on demand without a password
FUserInfo.LoadFromFile(FUserID);
// Check digest
if StrMD5(FServerMD5ID + FUserInfo.Password) = Para_Digest then
begin
// Be sure we havn't got another connection to this user already!
if FServer.IsUserAlreadyConnected(Self, FUserID) then begin
// Mailbox locked by same user on different connection
FState := pcs_AUTHENTICATION_WAITUSER;
FSocket.SendStr('-ERR Cannot Lock Mailbox' + CRLF);
StatusUpdate('User Password OK, but mailbox locked.',
STAT_COMMANDERROR);
end else begin
// Mailbox available, Get Mailbox information
FState := pcs_TRANSACTION;
FMailInfo.ReadFolder(FUserID);
FSocket.SendStr('+OK ' + IntToStr(FMailInfo.Count) + ' ' +
IntToStr(FMailInfo.ByteCount) + CRLF);
StatusUpdate('User Password OK', STAT_COMMANDEVENT);
end;
end else begin
// MD5 digest didn't match... user not accepted
FState := pcs_AUTHENTICATION_WAITUSER;
FSocket.SendStr('-ERR Bad Digest' + CRLF);
StatusUpdate('User Digest BAD', STAT_COMMANDERROR);
end;
end else begin
// User Name not recognized
FSocket.SendStr('-ERR Unknown User' + CRLF);
StatusUpdate('User ' + Para_UserName + ' BAD', STAT_COMMANDERROR);
end;
end else begin
// We need a name and digest
FSocket.SendStr('-ERR Command Incomplete' + CRLF);
StatusUpdate('Command missing parameters', STAT_COMMANDERROR);
end;
end else
if (Command = 'QUIT') and
(FSocket.State = wsConnected) then begin
if FState = pcs_TRANSACTION then begin
// Enter "Update" state and Delete marked messages
x := FMailInfo.DeleteMarkedMessages;
FSocket.SendStr('+OK ' + IntToStr(x) + ' Messages Deleted. Bye.' +
CRLF);
StatusUpdate('Updated', STAT_CONNECTIONEVENT);
end else begin
// No update, just goodbye
FSocket.SendStr('+OK Signing Off' + CRLF);
StatusUpdate('NOT Updated', STAT_CONNECTIONEVENT);
end;
// Close socket, this will eventually terminate the component
FSocket.Close;
end else
if (Command = 'STAT') and
(FState = pcs_TRANSACTION) and
(FSocket.State = wsConnected) then begin
// Get status of mailbox
FSocket.SendStr('+OK ' + IntToStr(FMailInfo.Count) + ' ' +
IntToStr(FMailInfo.ByteCount) + CRLF);
StatusUpdate('Status: ' + IntToStr(FMailInfo.Count) + ' ' +
IntToStr(FMailInfo.ByteCount), STAT_COMMANDEVENT);
end else
if (Command = 'LIST') and
(FState = pcs_TRANSACTION) and
(FSocket.State = wsConnected) then begin
// List info on one or more messages
// Get message number if avaiable
if Parameter1 <> '' then begin
// We want info on a single message
try
Para_MessageID := StrToInt(Parameter1);
except
on E: Exception do Para_MessageID := -1
end;
// Find the message
MailItem := FMailInfo.Find(Para_MessageID);
if MailItem = nil then begin
FSocket.SendStr('-ERR No Such Message' + CRLF);
StatusUpdate('No such message', STAT_COMMANDERROR);
end else
if MailItem.MarkForDelete then begin
FSocket.SendStr('-ERR Message Deleted' + CRLF);
StatusUpdate('Message Deleted', STAT_COMMANDERROR);
end else begin
FSocket.SendStr('+OK ' + IntToSTr(MailItem.Number) + ' ' +
IntToSTr(MailItem.FileSize) + CRLF);
StatusUpdate('Info: ' + IntToSTr(MailItem.Number) + ' ' +
IntToSTr(MailItem.FileSize), STAT_COMMANDEVENT);
end;
end else begin
FSocket.SendStr('+OK ' + IntToStr(FMailInfo.Count) + ' Messages ' +
IntToStr(FMailInfo.ByteCount) + ' octets' + CRLF);
StatusUpdate('Info: ' + IntToSTr(FMailInfo.Count) + ' Messages ' +
IntToSTr(FMailInfo.ByteCount) + ' octets',
STAT_COMMANDEVENT);
for x := 0 to FMailInfo.Count -1 do begin
MailItem := FMailInfo.Mail[x];
FSocket.SendStr(IntToStr(MailItem.Number) + ' ' +
IntToStr(MailItem.FileSize) + CRLF);
end;
FSocket.SendStr('.' + CRLF); // multi-line listings must end with '.'
end;
end else
if (Command = 'RETR') and
(FState = pcs_TRANSACTION) and
(FSocket.State = wsConnected) then begin
// User wants a message
// Which message does the user want?
if Parameter1 <> '' then begin
try
Para_MessageID := StrToInt(Parameter1);
except
on E: Exception do Para_MessageID := -1
end;
// Find the message
MailItem := FMailInfo.Find(Para_MessageID);
if MailItem = nil then begin
FSocket.SendStr('-ERR No Such Message' + CRLF);
StatusUpdate('No Such Message', STAT_COMMANDERROR);
end else
if MailItem.MarkForDelete then begin
FSocket.SendStr('-ERR Message Deleted' + CRLF);
StatusUpdate('Message Deleted', STAT_COMMANDERROR);
end else begin
FSocket.SendStr('+OK ' + IntToSTr(MailItem.FileSize) + ' octets' +
CRLF);
StatusUpdate('Message: ' + IntToSTr(MailItem.FileSize) + ' octets',
STAT_COMMANDEVENT);
// Message itself
SL := TStringList.Create;
SL.LoadFromFile(INI.MailBoxPath + FUserID + '\' + MailItem.Filename);
// Stuff . byte
for x := 0 to SL.Count -1 do begin
if Copy(SL[x], 1, 1) = '.' then
FSocket.SendStr('.' + SL[x] + CRLF)
else
FSocket.SendStr(SL[x] + CRLF);
if x mod 700 = 0 then
StatusUpdate('Sent: ' + IntToSTr(x) + ' of ' +
IntToStr(SL.Count) + ' lines.', STAT_PROCESSINGEVENT);
end;
SL.Free;
// Send terminator
StatusUpdate('Sent: Terminator.', STAT_PROCESSINGEVENT);
FSocket.SendStr('.' + CRLF);
end;
end else begin
FSocket.SendStr('-ERR No Message Specified' + CRLF);
StatusUpdate('No Message Specified', STAT_COMMANDERROR);
end;
end else
if (Command = 'DELE') and
(FState = pcs_TRANSACTION) and
(FSocket.State = wsConnected) then begin
// Mark a message for delete
// which message?
if Parameter1 <> '' then begin
try
Para_MessageID := StrToInt(Parameter1);
except
on E: Exception do Para_MessageID := -1
end;
// Find message
MailItem := FMailInfo.Find(Para_MessageID);
if MailItem = nil then begin
FSocket.SendStr('-ERR No Such Message' + CRLF);
StatusUpdate('No Such Message', STAT_COMMANDERROR);
end else
if MailItem.MarkForDelete then begin
FSocket.SendStr('-ERR Message Already Deleted' + CRLF);
StatusUpdate('Message Already Deleted', STAT_COMMANDERROR);
end else begin
MailItem.MarkForDelete := True;
FSocket.SendStr('+OK Message ' + IntToSTr(MailItem.Number) +
' Deleted' + CRLF);
StatusUpdate('Message ' + IntToSTr(MailItem.Number) + ' Deleted',
STAT_COMMANDEVENT);
end;
end else begin
FSocket.SendStr('-ERR No Message Specified' + CRLF);
StatusUpdate('No Message Specified', STAT_COMMANDERROR);
end;
end else
if (Command = 'NOOP') and
(FState = pcs_TRANSACTION) and
(FSocket.State = wsConnected) then begin
// No operation
FSocket.SendStr('+OK' + CRLF);
end else
if (Command = 'RSET') and
(FState = pcs_TRANSACTION) and
(FSocket.State = wsConnected) then begin
// un-mark messages marked for delete
for x := 0 to FMailInfo.Count -1 do begin
MailItem := FMailInfo.Mail[x];
MailItem.MarkForDelete := False;
end;
FSocket.SendStr('+OK' + CRLF);
StatusUpdate('Message(s) Un-Deleted', STAT_COMMANDEVENT);
end else
if (Command = 'TOP') and // Optional
(FState = pcs_TRANSACTION) and
(FSocket.State = wsConnected) then begin
// User wants top n lines of message
// Find message number and number of lines
if Parameter1 <> '' then begin
Parameter2 := '';
if Pos(' ', Parameter1) > 0 then begin
Parameter2 := Trim(Copy(Parameter1, Pos(' ', Parameter1),
Length(Parameter1)));
Parameter1 := Trim(Copy(Parameter1, 1, Pos(' ', Parameter1)));
end;
try
Para_MessageID := StrToInt(Parameter1);
except
on E: Exception do Para_MessageID := -1
end;
try
Para_LineCount := StrToInt(Parameter2);
except
on E: Exception do Para_LineCount := -1
end;
// Find message
MailItem := FMailInfo.Find(Para_MessageID);
if MailItem = nil then begin
FSocket.SendStr('-ERR No Such Message' + CRLF);
StatusUpdate('No Such Message', STAT_COMMANDERROR);
end else
if MailItem.MarkForDelete then begin
FSocket.SendStr('-ERR Message Deleted' + CRLF);
StatusUpdate('Message Deleted', STAT_COMMANDERROR);
end else begin
FSocket.SendStr('+OK' + CRLF);
// Message itself
SL := TStringList.Create;
SL.LoadFromFile(INI.MailBoxPath + FUserID + '\' + MailItem.Filename);
// Find where the header stops!
HeaderBreak := SL.Count -1;
for x := SL.Count -1 downto 0 do if SL[x] = '' then HeaderBreak := x;
// Write Header (do we byte stuff the header? I will)
for x := 0 to HeaderBreak do
if Copy(SL[x], 1, 1) = '.' then
FSocket.SendStr('.' + SL[x] + CRLF)
else FSocket.SendStr(SL[x] + CRLF);
// Write Body
y := HeaderBreak + Para_LineCount;
if y > SL.Count then y := SL.Count;
// Stuff . byte
for x := (HeaderBreak +1) to y do
if Copy(SL[x], 1, 1) = '.' then
FSocket.SendStr('.' + SL[x] + CRLF)
else FSocket.SendStr(SL[x] + CRLF);
SL.Free;
// Send terminator
FSocket.SendStr('.' + CRLF);
StatusUpdate('Sent ' + IntToStr(y) + ' lines', STAT_COMMANDEVENT);
end;
end else begin
FSocket.SendStr('-ERR No Message Specified' + CRLF);
StatusUpdate('No Message Specified', STAT_COMMANDERROR);
end;
end else
if (Command = 'UIDL') and // Optional
(FState = pcs_TRANSACTION) and
(FSocket.State = wsConnected) then begin
// We don't support the UID!!!
FSocket.SendStr('-ERR Command Not Supported' + CRLF);
StatusUpdate('Command Not Supported', STAT_COMMANDERROR);
end else
begin // Unknown command
if FSocket.State = wsConnected then
FSocket.SendStr('-ERR Unrecognized Command' + CRLF);
end;
end;
end;
procedure TPop3Connection.SocketSessionClosed(Sender: TObject; Error: Word);
begin
StatusUpdate('Closed', STAT_CONNECTIONEVENT);
// Socket is closed, we must tell Server Object
// to free this connection. There's no point to
// carrying on without a connection, now is there?
PostMessage(FServer.Handle, WM_FREECONNECTION, Integer(Self), 0);
end;
procedure TPop3Connection.SocketError(Sender: TObject);
begin
StatusUpdate('Socket Error', STAT_CONNECTIONERROR);
// We had a socket error. This isn't a protocol error like the user
// typed the wrong command, it's a dropped connection, or something else.
// we'll close on this too, because we don't know how to recover from it.
// the user can open a new connection if they really want.
Close; // Close on Error
end;
procedure TPop3Connection.SocketBgException(Sender: TObject; E: Exception;
var CanClose: Boolean);
begin
StatusUpdate('Background Exception Error', STAT_CRITICALERROR);
// We had a background exception. This is like a socket error in that
// we don't know what happened, and we don't know how to recover, so
// we'd better just close this connection.
Close; // Close on Error
end;
(******************************************************************************)
(* *)
(* STOP POP3 Connection Object *)
(* *)
(******************************************************************************)
end.