clpop3server.pas

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

  AConnection.InitParams();
  StartTls(AConnection);
end;

procedure TclPop3Server.CheckTlsMode(AConnection: TclPop3CommandConnection; const ACommand: string);
begin
  if (UseTLS = stExplicitRequire) and (not AConnection.IsTls) then
  begin
    RaisePopError(ACommand, 'Must issue a STLS command first');
  end;
end;

procedure TclPop3Server.HandleHELP(AConnection: TclPop3CommandConnection; const ACommand, AParams: string);
var
  helpStr: string;
begin
  helpStr := HelpText.Text;
  helpStr := StringReplace(helpStr, #13#10, ', ', [rfReplaceAll]);
  helpStr := Trim(helpStr);
  if (helpStr <> '') and (helpStr[Length(helpStr)] = ',') then
  begin
    helpStr := ' ' + system.Copy(helpStr, 1, Length(helpStr) - 1);
  end;

  SendResponse(AConnection, ACommand, OkResponse + helpStr);
end;

procedure TclPop3Server.SetHelpText(const Value: TStrings);
begin
  FHelpText.Assign(Value);
end;

procedure TclPop3Server.FillDefaultHelpText;
begin
  HelpText.Add('Valid commands: USER');
  HelpText.Add('PASS');
  HelpText.Add('APOP');
  HelpText.Add('AUTH');
  HelpText.Add('QUIT');
  HelpText.Add('NOOP');
  HelpText.Add('HELP');
  HelpText.Add('STAT');
  HelpText.Add('RETR');
  HelpText.Add('TOP');
  HelpText.Add('DELE');
  HelpText.Add('RSET');
  HelpText.Add('LIST');
  HelpText.Add('UIDL');
  HelpText.Add('STLS');
end;

procedure TclPop3Server.HandleAUTH(AConnection: TclPop3CommandConnection; const ACommand, AParams: string);
var
  encoder: TclEncoder;
  method, s: string;
  list: TStrings;
begin
  CheckTlsMode(AConnection, ACommand);
  CheckConnectionState(ACommand, AConnection.ConnectionState, csPop3Authorization);

  if not (UseAuth in [pmSASL, pmBoth]) then
  begin
    RaiseSyntaxError(ACommand);
  end;

  method := UpperCase(Trim(AParams));

  if (method = '') then
  begin
    list := TStringList.Create();
    AddMultipleLines(AConnection, list);
    if (ssUseNTLM in SASLFlags) then
    begin
      list.Add('NTLM');
    end;
    if (ssUseCramMD5 in SASLFlags) then
    begin
      list.Add('CRAM-MD5');
    end;
    SendResponse(AConnection, ACommand, OkResponse);
    SendMultipleLines(AConnection, '.', True);
  end else
  if (method = 'CRAM-MD5') and (ssUseCramMD5 in SASLFlags) then
  begin
    encoder := TclEncoder.Create(nil);
    try
      AConnection.FCramMD5Key := GenCramMD5Key();
      encoder.EncodeString(AConnection.CramMD5Key, s, cmMIMEBase64);
      AConnection.FReceivingData := rdPop3CramMD5;
      SendResponse(AConnection, ACommand, '+ ' + s);
    finally
      encoder.Free();
    end;
  end else
  if (method = 'NTLM') and (ssUseNTLM in SASLFlags) then
  begin
    AConnection.FNTLMAuth.Free();
    AConnection.FNTLMAuth := TclNtAuthServerSspi.Create();
    AConnection.FReceivingData := rdPop3NTLM;
    SendResponse(AConnection, ACommand, '+ OK'); //NTLM + OK
  end else
  begin
    RaiseSyntaxError(ACommand);
  end;
end;

procedure TclPop3Server.HandleNTLM(AConnection: TclPop3CommandConnection;
  const AData: string);
begin
  AConnection.RawData := AData;
  HandleEndCommand(AConnection, 'AUTH', HandleNTLMEnd);
end;

procedure TclPop3Server.HandleNTLMEnd(
  AConnection: TclPop3CommandConnection; const ACommand, AParams: string);
var
  buf: TStream;
  encoder: TclEncoder;
  challenge: string;
begin
  CheckAuthAbort(AConnection, Trim(AConnection.RawData));

  try
    encoder := nil;
    buf := nil;
    try
      encoder := TclEncoder.Create(nil);
      encoder.SuppressCrlf := True;
      buf := TMemoryStream.Create();

      encoder.DecodeFromString(Trim(AConnection.RawData), buf, cmMIMEBase64);
      buf.Position := 0;

      if AConnection.FNTLMAuth.GenChallenge('NTLM', buf, nil) then
      begin
        AConnection.FNTLMAuth.ImpersonateUser();
        try
          AConnection.FUserName := GetCurrentThreadUser();

          if not NtlmAuthenticate(AConnection, UserAccounts.AccountByUserName(AConnection.UserName)) then
          begin
            AConnection.FUserName := '';
            RaisePopError(ACommand, 'incorrect password or account name');
          end;
        finally
          AConnection.FNTLMAuth.RevertUser();
        end;

        AConnection.FReceivingData := rdPop3Command;
        ChangeState(ACommand, AConnection, csPop3Transaction);
        SendResponse(AConnection, ACommand, OkResponse + ' ' + GetMailBoxInfo(AConnection, cMailBoxInfoFormat));
      end else
      begin
        buf.Position := 0;
        challenge := '';
        encoder.EncodeToString(buf, challenge, cmMIMEBase64);

        SendResponse(AConnection, ACommand, '+ ' + challenge);
      end;
    finally
      buf.Free();
      encoder.Free();
    end;
  except
    on EclEncoderError do CheckAuthAbort(AConnection, '*');
    on EclSSPIError do CheckAuthAbort(AConnection, '*');
  end;
end;

procedure TclPop3Server.HandleCramMD5(AConnection: TclPop3CommandConnection; const AData: string);
begin
  AConnection.RawData := AData;
  AConnection.FReceivingData := rdPop3Command;
  HandleEndCommand(AConnection, 'AUTH', HandleCramMD5End);
end;

procedure TclPop3Server.HandleCramMD5End(AConnection: TclPop3CommandConnection;
  const ACommand, AParams: string);
var
  encoder: TclEncoder;
  hash: string;
begin
  CheckAuthAbort(AConnection, AConnection.RawData);

  encoder := TclEncoder.Create(nil);
  try
    hash := '';
    try
      encoder.DecodeString(Trim(AConnection.RawData), hash, cmMIMEBase64);
    except
      on EclEncoderError do CheckAuthAbort(AConnection, '*');
    end;
    if (WordCount(hash, [' ']) <> 2) then
    begin
      CheckAuthAbort(AConnection, '*');
    end;
    AConnection.FUserName := ExtractWord(1, hash, [' ']);
    hash := ExtractWord(2, hash, [' ']);

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

procedure TclPop3Server.CheckAuthAbort(AConnection: TclPop3CommandConnection; const AParams: string);
begin
  if (Trim(AParams) = '*') then
  begin
    AConnection.InitParams();
    RaisePopError('AUTH', 'authentication aborted');
  end;
end;

procedure TclPop3Server.ProcessData(AConnection: TclCommandConnection; const AData: string);
var
  connection: TclPop3CommandConnection;
begin
  connection := AConnection as TclPop3CommandConnection;
  case connection.ReceivingData of
    rdPop3CramMD5: HandleCramMD5(connection, AData);
    rdPop3NTLM: HandleNTLM(connection, AData)
  else
    inherited ProcessData(connection, AData);
  end;
end;

function TclPop3Server.GenCramMD5Key: string;
begin
  Result := GenerateCramMD5Key();
end;

procedure TclPop3Server.HandleEndCommand(
  AConnection: TclPop3CommandConnection; const ACommand: string;
  AHandler: TclPop3CommandHandler);
var
  info: TclPop3CommandInfo;
  params: TclTcpCommandParams;
begin
  info := nil;
  params := nil;
  try
    info := TclPop3CommandInfo.Create();
    params := TclTcpCommandParams.Create();
    info.Name := ACommand;
    info.FHandler := AHandler;
    ProcessCommand(AConnection, info, params);
  finally
    params.Free();
    info.Free();
  end;
end;

function TclPop3Server.CramMD5Authenticate(
  AConnection: TclPop3CommandConnection; Account: TclUserAccountItem;
  const AKey, AHash: string): Boolean;
var
  handled: Boolean;
  calculated: string;
begin
  handled := False;
  Result := False;
  DoAuthAuthenticate(AConnection, Account, AKey, AHash, Result, handled);
  if (not handled) and (Account <> nil) then
  begin
    calculated := HMAC_MD5(AKey, Account.Password);
    Result := (calculated = AHash);
  end;
end;

function TclPop3Server.NtlmAuthenticate(
  AConnection: TclPop3CommandConnection; Account: TclUserAccountItem): Boolean;
var
  handled: Boolean;
begin
  handled := False;
  Result := True;
  DoAuthAuthenticate(AConnection, Account, '', '', Result, handled);
end;

procedure TclPop3Server.DoAuthAuthenticate(
  AConnection: TclPop3CommandConnection; Account: TclUserAccountItem;
  const AKey, AHash: string; var IsAuthorized, Handled: Boolean);
begin
  if Assigned(OnAuthAuthenticate) then
  begin
    OnAuthAuthenticate(Self, AConnection, Account, AKey, AHash, IsAuthorized, handled);
  end;
end;

{ TclPop3MessageList }

function TclPop3MessageList.Add: TclPop3MessageItem;
begin
  Result := TclPop3MessageItem(inherited Add());
end;

function TclPop3MessageList.GetItem(Index: Integer): TclPop3MessageItem;
begin
  Result := TclPop3MessageItem(inherited GetItem(Index));
end;

function TclPop3MessageList.GetActiveSize: Integer;
var
  i: Integer;
begin
  Result := 0;
  for i := 0 to Count - 1 do
  begin
    if (not Items[i].IsDeleted) then
    begin
      Result := Result + Items[i].Size;
    end;
  end;
end;

procedure TclPop3MessageList.SetItem(Index: Integer; const Value: TclPop3MessageItem);
begin
  inherited SetItem(Index, Value);
end;

function TclPop3MessageList.GetActiveCount: Integer;
var
  i: Integer;
begin
  Result := 0;
  for i := 0 to Count - 1 do
  begin
    if (not Items[i].IsDeleted) then
    begin
      Inc(Result);
    end;
  end;
end;

function TclPop3MessageList.MessageExists(AMessageNo: Integer): Boolean;
begin
  Result := (AMessageNo > 0) and (AMessageNo <= Count) and (not Items[AMessageNo - 1].IsDeleted);
end;

procedure TclPop3MessageList.MarkDeleted(AMessageNo: Integer);
begin
  Items[AMessageNo - 1].IsDeleted := True;
end;

procedure TclPop3MessageList.Reset;
var
  i: Integer;
begin
  for i := 0 to Count - 1 do
  begin
    Items[i].IsDeleted := False;
  end;
end;

{ TclPop3MessageItem }

procedure TclPop3MessageItem.Assign(Source: TPersistent);
var
  Src: TclPop3MessageItem;
begin
  if (Source is TclPop3MessageItem) then
  begin
    Src := (Source as TclPop3MessageItem);
    UID := Src.UID;
    Size := Src.Size;
    IsDeleted := Src.IsDeleted;
    ExtraInfo := Src.ExtraInfo;
  end else
  begin
    inherited Assign(Source);
  end;
end;

{ TclPop3CommandConnection }

constructor TclPop3CommandConnection.Create;
begin
  inherited Create();
  FMailBox := TclPop3MessageList.Create(TclPop3MessageItem);
  InitParams();
end;

procedure TclPop3CommandConnection.DoDestroy;
begin
  FNTLMAuth.Free();
  FMailBox.Free();
  inherited DoDestroy();
end;

procedure TclPop3CommandConnection.InitParams;
begin
  FConnectionState := csPop3Authorization;
  FReceivingData := rdPop3Command;
  FTimeStamp := '';
  FUserName := '';
  FCramMD5Key := '';
  FRawData := '';
  FMailBox.Clear();
  FNTLMAuth.Free();
  FNTLMAuth := nil;
end;

{ TclPop3CommandInfo }

procedure TclPop3CommandInfo.Execute(AConnection: TclCommandConnection; AParams: TclTcpCommandParams);
begin
  FHandler(AConnection as TclPop3CommandConnection, Name, AParams.Params);
end;

end.