clpop3server.pas

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

  if (not handled) and (Account <> nil) then
  begin
    calculated := MD5(AConnection.TimeStamp + Account.Password);
    Result := (calculated = ADigest);
  end;
end;

procedure TclPop3Server.DoLoginAuthenticate(AConnection: TclPop3CommandConnection; Account: TclUserAccountItem;
  const APassword: string; var IsAuthorized, Handled: Boolean);
begin
  if Assigned(OnLoginAuthenticate) then
  begin
    OnLoginAuthenticate(Self, AConnection, Account, APassword, IsAuthorized, Handled);
  end;
end;

procedure TclPop3Server.DoAPopAuthenticate(AConnection: TclPop3CommandConnection; Account: TclUserAccountItem;
  const ADigest: string; var IsAuthorized, Handled: Boolean);
begin
  if Assigned(OnAPopAuthenticate) then
  begin
    OnAPopAuthenticate(Self, AConnection, Account, ADigest, IsAuthorized, Handled);
  end;
end;

procedure TclPop3Server.HandleNOOP(AConnection: TclPop3CommandConnection; const ACommand, AParams: string);
begin
  CheckTlsMode(AConnection, ACommand);
  CheckConnectionState(ACommand, AConnection.ConnectionState, csPop3Transaction);
  SendResponse(AConnection, ACommand, OkResponse);
end;

procedure TclPop3Server.HandleQUIT(AConnection: TclPop3CommandConnection; const ACommand, AParams: string);
begin
  try
    if (AConnection.ConnectionState = csPop3Transaction) then
    begin
      ChangeState(ACommand, AConnection, csPop3Update);
    end;
    SendResponse(AConnection, ACommand, OkResponse + ' ' + ServerName + ' connection closed');
    AConnection.Close(False);
  except
    on EclSocketError do ;
  end;
end;

procedure TclPop3Server.HandleRSET(AConnection: TclPop3CommandConnection; const ACommand, AParams: string);
begin
  CheckTlsMode(AConnection, ACommand);
  CheckConnectionState(ACommand, AConnection.ConnectionState, csPop3Transaction);

  DoReset(AConnection);

  AConnection.MailBox.Reset();

  SendResponse(AConnection, ACommand, OkResponse);
end;

procedure TclPop3Server.HandleSTAT(AConnection: TclPop3CommandConnection; const ACommand, AParams: string);
begin
  CheckTlsMode(AConnection, ACommand);
  CheckConnectionState(ACommand, AConnection.ConnectionState, csPop3Transaction);
  SendResponse(AConnection, ACommand, '%s %d %d',
    [OkResponse, AConnection.MailBox.ActiveCount, AConnection.MailBox.ActiveSize]);
end;

procedure TclPop3Server.HandleRETR(AConnection: TclPop3CommandConnection; const ACommand, AParams: string);
var
  messageNo: Integer;
  msg: TStrings;
  success: Boolean;
begin
  CheckTlsMode(AConnection, ACommand);
  CheckConnectionState(ACommand, AConnection.ConnectionState, csPop3Transaction);

  messageNo := StrToIntDef(Trim(AParams), 0);

  if not AConnection.MailBox.MessageExists(messageNo) then
  begin
    RaiseNotFoundError(ACommand);
  end;

  msg := TStringList.Create();
  AddMultipleLines(AConnection, msg);
  success := True;
  DoRetrieve(AConnection, messageNo, 0, True, msg, success);
  if not success then
  begin
    RaiseNotFoundError(ACommand);
  end;

  SendResponse(AConnection, ACommand, OkResponse + ' %d', [GetStringsSize(msg)]);
  SendMultipleLines(AConnection, '.', True);
end;

procedure TclPop3Server.HandleTOP(AConnection: TclPop3CommandConnection; const ACommand, AParams: string);
var
  messageNo, lines: Integer;
  msg: TStrings;
  params: string;
  success: Boolean;
begin
  CheckTlsMode(AConnection, ACommand);
  CheckConnectionState(ACommand, AConnection.ConnectionState, csPop3Transaction);

  params := Trim(AParams);

  if (WordCount(params, [#32]) < 2) then
  begin
    RaiseSyntaxError(ACommand);
  end;

  messageNo := StrToIntDef(ExtractWord(1, params, [#32]), 0);
  lines := StrToIntDef(ExtractWord(2, params, [#32]), 0);

  if not AConnection.MailBox.MessageExists(messageNo) then
  begin
    RaiseNotFoundError(ACommand);
  end;

  msg := TStringList.Create();
  AddMultipleLines(AConnection, msg);
  success := True;
  DoRetrieve(AConnection, messageNo, lines, False, msg, success);
  if not success then
  begin
    RaiseNotFoundError(ACommand);
  end;

  SendResponse(AConnection, ACommand, OkResponse);
  SendMultipleLines(AConnection, '.', True);
end;

procedure TclPop3Server.HandleDELE(AConnection: TclPop3CommandConnection; const ACommand, AParams: string);
var
  messageNo: Integer;
  canDelete: Boolean;
begin
  CheckTlsMode(AConnection, ACommand);
  CheckConnectionState(ACommand, AConnection.ConnectionState, csPop3Transaction);

  messageNo := StrToIntDef(Trim(AParams), 0);
  canDelete := True;

  if not AConnection.MailBox.MessageExists(messageNo) then
  begin
    RaiseNotFoundError(ACommand);
  end;
  
  DoDelete(AConnection, messageNo, canDelete);
  if not canDelete then
  begin
    RaiseNotFoundError(ACommand);
  end;

  AConnection.MailBox.MarkDeleted(messageNo);

  SendResponse(AConnection, ACommand, '%s message %d deleted', [OkResponse, messageNo]);
end;

procedure TclPop3Server.HandleLIST(AConnection: TclPop3CommandConnection; const ACommand, AParams: string);
var
  messageNo: Integer;
  list: TStrings;
begin
  CheckTlsMode(AConnection, ACommand);
  CheckConnectionState(ACommand, AConnection.ConnectionState, csPop3Transaction);

  messageNo := StrToIntDef(Trim(AParams), 0);

  if (messageNo > 0) then
  begin
    if not AConnection.MailBox.MessageExists(messageNo) then
    begin
      RaiseNotFoundError(ACommand);
    end;

    SendResponse(AConnection, ACommand, '%s %d %d',
      [OkResponse, messageNo, AConnection.MailBox[messageNo - 1].Size]);
  end else
  begin
    SendResponse(AConnection, ACommand, '%s %d %d',
      [OkResponse, AConnection.MailBox.ActiveCount, AConnection.MailBox.ActiveSize]);

    list := TStringList.Create();
    AddMultipleLines(AConnection, list);
    CollectActiveMessages(AConnection, list);
    SendMultipleLines(AConnection, '.', True);
  end;
end;

procedure TclPop3Server.HandleUIDL(AConnection: TclPop3CommandConnection; const ACommand, AParams: string);
var
  messageNo: Integer;
  list: TStrings;
begin
  CheckTlsMode(AConnection, ACommand);
  CheckConnectionState(ACommand, AConnection.ConnectionState, csPop3Transaction);

  messageNo := StrToIntDef(Trim(AParams), 0);

  if (messageNo > 0) then
  begin
    if not AConnection.MailBox.MessageExists(messageNo) then
    begin
      RaiseNotFoundError(ACommand);
    end;
    SendResponse(AConnection, ACommand, '%s %d %s',
      [OkResponse, messageNo, AConnection.MailBox[messageNo - 1].UID]);
  end else
  begin
    SendResponse(AConnection, ACommand, OkResponse);

    list := TStringList.Create();
    AddMultipleLines(AConnection, list);
    CollectActiveMessageUids(AConnection, list);
    SendMultipleLines(AConnection, '.', True);
  end;
end;

procedure TclPop3Server.CollectActiveMessages(AConnection: TclPop3CommandConnection; AList: TStrings);
var
  i: Integer;
begin
  AList.Clear();
  for i := 0 to AConnection.MailBox.Count - 1 do
  begin
    if (not AConnection.MailBox[i].IsDeleted) then
    begin
      AList.Add(Format('%d %d', [i + 1, AConnection.MailBox[i].Size]));
    end;
  end;
end;

procedure TclPop3Server.CollectActiveMessageUids(AConnection: TclPop3CommandConnection; AList: TStrings);
var
  i: Integer;
begin
  AList.Clear();
  for i := 0 to AConnection.MailBox.Count - 1 do
  begin
    if (not AConnection.MailBox[i].IsDeleted) then
    begin
      AList.Add(Format('%d %s', [i + 1, AConnection.MailBox[i].UID]));
    end;
  end;
end;

procedure TclPop3Server.SetUserAccounts(const Value: TclUserAccountList);
begin
  FUserAccounts.Assign(Value);
end;

function TclPop3Server.GetCaseInsensitive: Boolean;
begin
  Result := FUserAccounts.CaseInsensitive;
end;

procedure TclPop3Server.SetCaseInsensitive(const Value: Boolean);
begin
  FUserAccounts.CaseInsensitive := Value;
end;

procedure TclPop3Server.RaiseSyntaxError(const ACommand: string);
begin
  RaisePopError(ACommand, 'Invalid command');
end;

procedure TclPop3Server.DoDestroy;
begin
  FHelpText.Free();
  FUserAccounts.Free();
  FConnectionAccess.Free();
  inherited DoDestroy();
end;

function TclPop3Server.GenerateTimeStamp: string;
begin
  Result := GenerateMessageID();
end;

procedure TclPop3Server.DoMailBoxInfo(AConnection: TclPop3CommandConnection;
  AMailBox: TclPop3MessageList);
begin
  if Assigned(OnMailBoxInfo) then
  begin
    OnMailBoxInfo(Self, AConnection, AMailBox);
  end;
end;

function TclPop3Server.GetMailBoxInfo(AConnection: TclPop3CommandConnection;
  const AFormat: string): string;
begin
  DoMailBoxInfo(AConnection, AConnection.MailBox);
  Result := Format(AFormat, [AConnection.MailBox.ActiveCount, AConnection.MailBox.ActiveSize]);
end;

procedure TclPop3Server.RaiseNotFoundError(const ACommand: string);
begin
  RaisePopError(ACommand, 'no such message');
end;

procedure TclPop3Server.DoRetrieve(AConnection: TclPop3CommandConnection;
  AMessageNo, ATopLines: Integer; ARetrieveAll: Boolean; AMessageSource: TStrings;
  var Success: Boolean);
begin
  if Assigned(OnRetrieve) then
  begin
    OnRetrieve(Self, AConnection, AMessageNo, ATopLines, ARetrieveAll, AMessageSource, Success);
  end;
end;

procedure TclPop3Server.DoDelete(AConnection: TclPop3CommandConnection;
  AMessageNo: Integer; var ACanDelete: Boolean);
begin
  if Assigned(OnDelete) then
  begin
    OnDelete(Self, AConnection, AMessageNo, ACanDelete);
  end;
end;

procedure TclPop3Server.DoStateChanged(AConnection: TclPop3CommandConnection);
begin
  if Assigned(OnStateChanged) then
  begin
    OnStateChanged(Self, AConnection);
  end;
end;

procedure TclPop3Server.DoCloseConnection(AConnection: TclCommandConnection);
var
  command: TclPop3CommandConnection;
begin
  inherited DoCloseConnection(AConnection);

  command := AConnection as TclPop3CommandConnection;
  ChangeState('', command, csPop3Authorization);
end;

procedure TclPop3Server.DoReset(AConnection: TclPop3CommandConnection);
begin
  if Assigned(OnReset) then
  begin
    OnReset(Self, AConnection);
  end;
end;

function TclPop3Server.GetConnectionByUser(const AUserName: string): TclPop3CommandConnection;
var
  i: Integer;
begin
  for i := 0 to ConnectionCount - 1 do
  begin
    Result := (Connections[i] as TclPop3CommandConnection);
    if SameText(Result.UserName, AUserName)
      and (Result.ConnectionState = csPop3Transaction) then
    begin
      Exit;
    end;
  end;
  Result := nil;
end;

procedure TclPop3Server.ChangeState(const ACommand: string; AConnection: TclPop3CommandConnection;
  ANewState: TclPop3ConnectionState);
begin
  FConnectionAccess.Enter();
  try
    if (ANewState = csPop3Transaction) and (GetConnectionByUser(AConnection.UserName) <> nil) then
    begin
      RaisePopError(ACommand, 'maildrop already locked');
    end;
    AConnection.FConnectionState := ANewState;
    DoStateChanged(AConnection);
  finally
    FConnectionAccess.Leave();
  end;
end;

procedure TclPop3Server.HandleNullCommand(AConnection: TclPop3CommandConnection;
  const ACommand, AParams: string);
begin
  RaiseSyntaxError(ACommand);
end;

function TclPop3Server.GetNullCommand(const ACommand: string): TclTcpCommandInfo;
var
  info: TclPop3CommandInfo;
begin
  info := TclPop3CommandInfo.Create();
  info.Name := ACommand;
  info.FHandler := HandleNullCommand;
  Result := info;
end;

procedure TclPop3Server.ProcessUnhandledError(AConnection: TclCommandConnection;
  AParams: TclTcpCommandParams; E: Exception);
begin
  SendResponse(AConnection, AParams.Command, ErrResponse + ' access denied ');
end;

procedure TclPop3Server.DoProcessCommand(AConnection: TclCommandConnection;
  AInfo: TclTcpCommandInfo; AParams: TclTcpCommandParams);
begin
  AConnection.BeginWork();
  try
    inherited DoProcessCommand(AConnection, AInfo, AParams);
  finally
    AConnection.EndWork();
  end;
end;

procedure TclPop3Server.HandleSTLS(AConnection: TclPop3CommandConnection; const ACommand, AParams: string);
begin
  if (UseTLS = stNone) or (UseTLS = stImplicit) or AConnection.IsTls then
  begin
    RaiseSyntaxError(ACommand);
  end;

  SendResponse(AConnection, ACommand, OkResponse + ' start TLS negotiation');