clpop3server.pas

Clever_Internet_Suite_6.2的代码 Clever_Internet_Suite_6.2的代码 Clever_Internet_Suite_6.2的代码

{
  Clever Internet Suite Version 6.2
  Copyright (C) 1999 - 2006 Clever Components
  www.CleverComponents.com
}

unit clPop3Server;

interface

{$I clVer.inc}
{$IFDEF DELPHI6}
  {$WARN SYMBOL_PLATFORM OFF}
{$ENDIF}

{$IFDEF DELPHI7}
  {$WARN UNSAFE_CODE OFF}
  {$WARN UNSAFE_TYPE OFF}
  {$WARN UNSAFE_CAST OFF}
{$ENDIF}

uses
  Classes, SysUtils, WinSock, clTcpServer, clSocket, clUserMgr, SyncObjs, clMCUtils,
  clSspi, clSspiAuth;

type
  TclPop3ConnectionState = (csPop3Authorization, csPop3Transaction, csPop3Update);
  TclPop3ReceivingData = (rdPop3Command, rdPop3CramMD5, rdPop3NTLM);
  TclPop3AuthMode = (pmPopAuth, pmSASL, pmBoth);

  TclPop3MessageItem = class(TCollectionItem)
  private
    FIsDeleted: Boolean;
    FSize: Integer;
    FUID: string;
    FExtraInfo: string;
  public
    procedure Assign(Source: TPersistent); override;
    property UID: string read FUID write FUID;
    property Size: Integer read FSize write FSize;
    property IsDeleted: Boolean read FIsDeleted write FIsDeleted;
    property ExtraInfo: string read FExtraInfo write FExtraInfo;
  end;

  TclPop3MessageList = class(TCollection)
  private
    function GetItem(Index: Integer): TclPop3MessageItem;
    procedure SetItem(Index: Integer; const Value: TclPop3MessageItem);
    function GetActiveSize: Integer;
    function GetActiveCount: Integer;
  public
    function Add: TclPop3MessageItem;
    function MessageExists(AMessageNo: Integer): Boolean;
    procedure MarkDeleted(AMessageNo: Integer);
    procedure Reset;
    property Items[Index: Integer]: TclPop3MessageItem read GetItem write SetItem; default;
    property ActiveSize: Integer read GetActiveSize;
    property ActiveCount: Integer read GetActiveCount;
  end;

  TclPop3CommandConnection = class(TclCommandConnection)
  private
    FConnectionState: TclPop3ConnectionState;
    FTimeStamp: string;
    FUserName: string;
    FMailBox: TclPop3MessageList;
    FReceivingData: TclPop3ReceivingData;
    FCramMD5Key: string;
    FNTLMAuth: TclNtAuthServerSspi;
    FRawData: string;
  protected
    procedure DoDestroy; override;
  public
    constructor Create;
    procedure InitParams;
    property ConnectionState: TclPop3ConnectionState read FConnectionState;
    property ReceivingData: TclPop3ReceivingData read FReceivingData;
    property TimeStamp: string read FTimeStamp;
    property UserName: string read FUserName;
    property CramMD5Key: string read FCramMD5Key;
    property RawData: string read FRawData write FRawData;
    property MailBox: TclPop3MessageList read FMailBox;
  end;

  TclPop3CommandHandler = procedure (AConnection: TclPop3CommandConnection;
    const ACommand, AParams: string) of object;

  TclPop3CommandInfo = class(TclTcpCommandInfo)
  private
    FHandler: TclPop3CommandHandler;
  protected
    procedure Execute(AConnection: TclCommandConnection; AParams: TclTcpCommandParams); override;
  end;

  TclPop3LoginAuthenticateEvent = procedure (Sender: TObject; AConnection: TclPop3CommandConnection;
    Account: TclUserAccountItem; const APassword: string; var IsAuthorized, Handled: Boolean) of object;

  TclPop3APopAuthenticateEvent = procedure (Sender: TObject; AConnection: TclPop3CommandConnection;
    Account: TclUserAccountItem; const ADigest: string; var IsAuthorized, Handled: Boolean) of object;

  TclPop3AuthAuthenticateEvent = procedure (Sender: TObject; AConnection: TclPop3CommandConnection;
    Account: TclUserAccountItem; const AKey, AHash: string; var IsAuthorized, Handled: Boolean) of object;

  TclPop3MailBoxEvent = procedure (Sender: TObject; AConnection: TclPop3CommandConnection;
    AMailBox: TclPop3MessageList) of object;

  TclPop3RetrieveEvent = procedure (Sender: TObject; AConnection: TclPop3CommandConnection;
    AMessageNo, ATopLines: Integer; ARetrieveAll: Boolean; AMessageSource: TStrings;
    var Success: Boolean) of object;

  TclPop3DeleteEvent = procedure (Sender: TObject; AConnection: TclPop3CommandConnection;
    AMessageNo: Integer; var ACanDelete: Boolean) of object;

  TclPop3ConnectionEvent = procedure (Sender: TObject; AConnection: TclPop3CommandConnection) of object;

  TclPop3Server = class(TclTcpCommandServer)
  private
    FUserAccounts: TclUserAccountList;
    FUseAuth: TclPop3AuthMode;
    FSASLFlags: TclServerSaslFlags;
    FHelpText: TStrings;
    FConnectionAccess: TCriticalSection;
    FOnAPopAuthenticate: TclPop3APopAuthenticateEvent;
    FOnLoginAuthenticate: TclPop3LoginAuthenticateEvent;
    FOnMailBoxInfo: TclPop3MailBoxEvent;
    FOnRetrieve: TclPop3RetrieveEvent;
    FOnDelete: TclPop3DeleteEvent;
    FOnStateChanged: TclPop3ConnectionEvent;
    FOnReset: TclPop3ConnectionEvent;
    FOnAuthAuthenticate: TclPop3AuthAuthenticateEvent;
    procedure HandleNullCommand(AConnection: TclPop3CommandConnection; const ACommand, AParams: string);
    procedure HandleUSER(AConnection: TclPop3CommandConnection; const ACommand, AParams: string);
    procedure HandlePASS(AConnection: TclPop3CommandConnection; const ACommand, AParams: string);
    procedure HandleAPOP(AConnection: TclPop3CommandConnection; const ACommand, AParams: string);
    procedure HandleAUTH(AConnection: TclPop3CommandConnection; const ACommand, AParams: string);
    procedure HandleQUIT(AConnection: TclPop3CommandConnection; const ACommand, AParams: string);
    procedure HandleNOOP(AConnection: TclPop3CommandConnection; const ACommand, AParams: string);
    procedure HandleSTAT(AConnection: TclPop3CommandConnection; const ACommand, AParams: string);
    procedure HandleRETR(AConnection: TclPop3CommandConnection; const ACommand, AParams: string);
    procedure HandleTOP(AConnection: TclPop3CommandConnection; const ACommand, AParams: string);
    procedure HandleDELE(AConnection: TclPop3CommandConnection; const ACommand, AParams: string);
    procedure HandleRSET(AConnection: TclPop3CommandConnection; const ACommand, AParams: string);
    procedure HandleLIST(AConnection: TclPop3CommandConnection; const ACommand, AParams: string);
    procedure HandleUIDL(AConnection: TclPop3CommandConnection; const ACommand, AParams: string);
    procedure HandleSTLS(AConnection: TclPop3CommandConnection; const ACommand, AParams: string);
    procedure HandleHELP(AConnection: TclPop3CommandConnection; const ACommand, AParams: string);

    procedure HandleEndCommand(AConnection: TclPop3CommandConnection;
      const ACommand: string; AHandler: TclPop3CommandHandler);
    procedure HandleCramMD5(AConnection: TclPop3CommandConnection; const AData: string);
    procedure HandleCramMD5End(AConnection: TclPop3CommandConnection; const ACommand, AParams: string);
    procedure HandleNTLM(AConnection: TclPop3CommandConnection; const AData: string);
    procedure HandleNTLMEnd(AConnection: TclPop3CommandConnection; const ACommand, AParams: string);

    procedure CheckAuthAbort(AConnection: TclPop3CommandConnection; const AParams: string);
    procedure CheckTlsMode(AConnection: TclPop3CommandConnection; const ACommand: string);
    procedure CheckConnectionState(const ACommand: string; AState, ARequired: TclPop3ConnectionState);
    procedure RaiseSyntaxError(const ACommand: string);
    procedure RaiseNotFoundError(const ACommand: string);
    procedure SetUserAccounts(const Value: TclUserAccountList);
    function GetCaseInsensitive: Boolean;
    procedure SetCaseInsensitive(const Value: Boolean);
    function LoginAuthenticate(AConnection: TclPop3CommandConnection;
      Account: TclUserAccountItem; const APassword: string): Boolean;
    function APopAuthenticate(AConnection: TclPop3CommandConnection;
      Account: TclUserAccountItem; const ADigest: string): Boolean;
    function CramMD5Authenticate(AConnection: TclPop3CommandConnection;
      Account: TclUserAccountItem; const AKey, AHash: string): Boolean;
    function NtlmAuthenticate(AConnection: TclPop3CommandConnection;
      Account: TclUserAccountItem): Boolean;
    function GetMailBoxInfo(AConnection: TclPop3CommandConnection; const AFormat: string): string;
    procedure ChangeState(const ACommand: string; AConnection: TclPop3CommandConnection;
      ANewState: TclPop3ConnectionState);
    function GetConnectionByUser(const AUserName: string): TclPop3CommandConnection;
    procedure CollectActiveMessages(AConnection: TclPop3CommandConnection; AList: TStrings);
    procedure CollectActiveMessageUids(AConnection: TclPop3CommandConnection; AList: TStrings);
    procedure SetHelpText(const Value: TStrings);
    procedure FillDefaultHelpText;
  protected
    procedure AddPopCommand(const ACommand: string; AHandler: TclPop3CommandHandler);
    procedure RegisterCommands; override;
    function GetNullCommand(const ACommand: string): TclTcpCommandInfo; override;
    procedure ProcessUnhandledError(AConnection: TclCommandConnection;
      AParams: TclTcpCommandParams; E: Exception); override;
    procedure DoCloseConnection(AConnection: TclCommandConnection); override;
    procedure DoProcessCommand(AConnection: TclCommandConnection;
      AInfo: TclTcpCommandInfo; AParams: TclTcpCommandParams); override;
    procedure DoAcceptConnection(AConnection: TclCommandConnection); override;
    function CreateDefaultConnection: TclCommandConnection; override;
    procedure ProcessData(AConnection: TclCommandConnection; const AData: string); override;
    procedure DoDestroy; override;
    function GenerateTimeStamp: string; virtual;
    procedure DoLoginAuthenticate(AConnection: TclPop3CommandConnection; Account: TclUserAccountItem;
      const APassword: string; var IsAuthorized, Handled: Boolean); virtual;
    procedure DoAPopAuthenticate(AConnection: TclPop3CommandConnection; Account: TclUserAccountItem;
      const ADigest: string; var IsAuthorized, Handled: Boolean); virtual;
    procedure DoAuthAuthenticate(AConnection: TclPop3CommandConnection; Account: TclUserAccountItem;
      const AKey, AHash: string; var IsAuthorized, Handled: Boolean); virtual;
    procedure DoMailBoxInfo(AConnection: TclPop3CommandConnection;
      AMailBox: TclPop3MessageList); virtual;
    procedure DoRetrieve(AConnection: TclPop3CommandConnection;
      AMessageNo, ATopLines: Integer; ARetrieveAll: Boolean; AMessageSource: TStrings;
      var Success: Boolean); virtual;
    procedure DoDelete(AConnection: TclPop3CommandConnection; AMessageNo: Integer;
      var ACanDelete: Boolean); virtual;
    procedure DoStateChanged(AConnection: TclPop3CommandConnection); virtual;
    procedure DoReset(AConnection: TclPop3CommandConnection); virtual;
    function GenCramMD5Key: string; virtual;
  public
    constructor Create(AOwner: TComponent); override;
  published
    property Port default cDefaultPop3Port;
    property UseAuth: TclPop3AuthMode read FUseAuth write FUseAuth default pmBoth;
    property SASLFlags: TclServerSaslFlags read FSASLFlags write FSASLFlags default [ssUseCramMD5, ssUseNTLM];
    property UserAccounts: TclUserAccountList read FUserAccounts write SetUserAccounts;
    property CaseInsensitive: Boolean read GetCaseInsensitive write SetCaseInsensitive default True;
    property HelpText: TStrings read FHelpText write SetHelpText;
    property OnLoginAuthenticate: TclPop3LoginAuthenticateEvent read FOnLoginAuthenticate
      write FOnLoginAuthenticate;
    property OnAPopAuthenticate: TclPop3APopAuthenticateEvent read FOnAPopAuthenticate
      write FOnAPopAuthenticate;
    property OnAuthAuthenticate: TclPop3AuthAuthenticateEvent read FOnAuthAuthenticate write
      FOnAuthAuthenticate;
    property OnMailBoxInfo: TclPop3MailBoxEvent read FOnMailBoxInfo write FOnMailBoxInfo;
    property OnRetrieve: TclPop3RetrieveEvent read FOnRetrieve write FOnRetrieve;
    property OnDelete: TclPop3DeleteEvent read FOnDelete write FOnDelete;
    property OnStateChanged: TclPop3ConnectionEvent read FOnStateChanged write FOnStateChanged;
    property OnReset: TclPop3ConnectionEvent read FOnReset write FOnReset;
  end;

procedure RaisePopError(const ACommand, AMessage: string);

implementation

uses
  Windows, clTlsSocket, clUtils, clCryptUtils, clEncoder;

const
  OkResponse = '+OK';
  ErrResponse = '-ERR';
  cMailBoxInfoFormat = '%d messages (%d octets)';

procedure RaisePopError(const ACommand, AMessage: string);
begin
  raise EclTcpCommandError.Create(ACommand, ErrResponse + ' ' + AMessage, -1);
end;

{ TclPop3Server }

procedure TclPop3Server.AddPopCommand(const ACommand: string;
  AHandler: TclPop3CommandHandler);
var
  info: TclPop3CommandInfo;
begin
  info := TclPop3CommandInfo.Create();
  AddCommand(info);
  info.Name := ACommand;
  info.FHandler := AHandler;
end;

constructor TclPop3Server.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  FConnectionAccess := TCriticalSection.Create();
  FUserAccounts := TclUserAccountList.Create(Self, TclUserAccountItem);
  FHelpText := TStringList.Create();
  FillDefaultHelpText();
  Port := cDefaultPop3Port;
  ServerName := 'Clever Internet Suite POP3 service';
  CaseInsensitive := True;
  FUseAuth := pmBoth;
  SASLFlags := [ssUseCramMD5, ssUseNTLM];
end;

function TclPop3Server.CreateDefaultConnection: TclCommandConnection;
begin
  Result := TclPop3CommandConnection.Create();
end;

procedure TclPop3Server.DoAcceptConnection(AConnection: TclCommandConnection);
var
  command: TclPop3CommandConnection;
  banner: string;
begin
{$IFDEF DEMO}
{$IFNDEF STANDALONEDEMO}
  if FindWindow('TAppBuilder', nil) = 0 then
  begin
    MessageBox(0, 'This demo version can be run under Delphi/C++Builder IDE only. ' + 
      'Please visit www.clevercomponents.com to purchase your ' +
      'copy of the library.', 'Information', MB_ICONEXCLAMATION  or MB_TASKMODAL or MB_TOPMOST);
    ExitProcess(1);
  end;
{$ENDIF}
{$ENDIF}

  inherited DoAcceptConnection(AConnection);
  command := (AConnection as TclPop3CommandConnection);
  command.FTimeStamp := GenerateTimeStamp();
  banner := OkResponse + ' ' + ServerName + ' ready';

  if (UseAuth in [pmPopAuth, pmBoth]) then
  begin
    banner := banner + ' ' + command.TimeStamp;
  end;

  SendResponse(AConnection, '', banner);
end;

procedure TclPop3Server.RegisterCommands;
begin
  AddPopCommand('USER', HandleUSER);
  AddPopCommand('PASS', HandlePASS);
  AddPopCommand('APOP', HandleAPOP);
  AddPopCommand('AUTH', HandleAUTH);
  AddPopCommand('NOOP', HandleNOOP);
  AddPopCommand('QUIT', HandleQUIT);
  AddPopCommand('RSET', HandleRSET);
  AddPopCommand('STAT', HandleSTAT);
  AddPopCommand('RETR', HandleRETR);
  AddPopCommand('TOP', HandleTOP);
  AddPopCommand('DELE', HandleDELE);
  AddPopCommand('LIST', HandleLIST);
  AddPopCommand('UIDL', HandleUIDL);
  AddPopCommand('STLS', HandleSTLS);
  AddPopCommand('HELP', HandleHELP);
end;

procedure TclPop3Server.CheckConnectionState(const ACommand: string; AState, ARequired: TclPop3ConnectionState);
const
  states: array[TclPop3ConnectionState] of string = ('AUTHORIZATION', 'TRANSACTION', 'UPDATE');
begin
  if (AState <> ARequired) then
  begin
    RaisePopError(ACommand, 'that command is valid only in the ' + states[ARequired] + ' state!');
  end;
end;

procedure TclPop3Server.HandleUSER(AConnection: TclPop3CommandConnection; const ACommand, AParams: string);
begin
  CheckTlsMode(AConnection, ACommand);
  CheckConnectionState(ACommand, AConnection.ConnectionState, csPop3Authorization);
  if not (UseAuth in [pmPopAuth, pmBoth]) then
  begin
    RaiseSyntaxError(ACommand);
  end;
  AConnection.FUserName := AParams;
  SendResponse(AConnection, ACommand, OkResponse + ' please send the PASS');
end;

procedure TclPop3Server.HandlePASS(AConnection: TclPop3CommandConnection; const ACommand, AParams: string);
begin
  CheckTlsMode(AConnection, ACommand);
  CheckConnectionState(ACommand, AConnection.ConnectionState, csPop3Authorization);
  if not (UseAuth in [pmPopAuth, pmBoth]) then
  begin
    RaiseSyntaxError(ACommand);
  end;

  if not LoginAuthenticate(AConnection, UserAccounts.AccountByUserName(AConnection.UserName), AParams) then
  begin
    AConnection.FUserName := '';
    RaisePopError(ACommand, 'incorrect password or account name');
  end;
  ChangeState(ACommand, AConnection, csPop3Transaction);
  SendResponse(AConnection, ACommand, OkResponse + ' ' + GetMailBoxInfo(AConnection, cMailBoxInfoFormat));
end;

procedure TclPop3Server.HandleAPOP(AConnection: TclPop3CommandConnection; const ACommand, AParams: string);
var
  digest: string;
begin
  CheckTlsMode(AConnection, ACommand);
  CheckConnectionState(ACommand, AConnection.ConnectionState, csPop3Authorization);
  if not (UseAuth in [pmPopAuth, pmBoth]) then
  begin
    RaiseSyntaxError(ACommand);
  end;

  digest := Trim(AParams);
  if (WordCount(digest, [' ']) <> 2) then
  begin
    RaiseSyntaxError(ACommand);
  end;

  AConnection.FUserName := ExtractWord(1, digest, [' ']);
  digest := ExtractWord(2, digest, [' ']);

  if not APopAuthenticate(AConnection, UserAccounts.AccountByUserName(AConnection.UserName), digest) then
  begin
    AConnection.FUserName := '';
    RaisePopError(ACommand, 'incorrect password or account name');
  end;
  ChangeState(ACommand, AConnection, csPop3Transaction);
  SendResponse(AConnection, ACommand, OkResponse + ' ' + GetMailBoxInfo(AConnection, cMailBoxInfoFormat));
end;

function TclPop3Server.LoginAuthenticate(AConnection: TclPop3CommandConnection;
  Account: TclUserAccountItem; const APassword: string): Boolean;
var
  handled: Boolean;
begin
  handled := False;
  Result := False;
  DoLoginAuthenticate(AConnection, Account, APassword, Result, handled);
  if (not handled) and (Account <> nil) then
  begin
    Result := Account.Authenticate(APassword);
  end;
end;

function TclPop3Server.APopAuthenticate(AConnection: TclPop3CommandConnection;
  Account: TclUserAccountItem; const ADigest: string): Boolean;
var
  handled: Boolean;
  calculated: string;
begin
  handled := False;
  Result := False;
  DoAPopAuthenticate(AConnection, Account, ADigest, Result, handled);