idsmtpserver.pas

photo.163.com 相册下载器 多线程下载

  DefaultPort := IdPORT_SMTP;
  FServerName  := 'Indy SMTP Server'; {do not localize}
  LS := (ReplyUnknownCommand as TIdReplySMTP);
  LS.SetEnhReply(500, Id_EHR_PR_SYNTAX_ERR, 'Syntax Error'); {do not localize}
  LS := (Greeting as TIdReplySMTP);
  LS.SetEnhReply(220, '' ,RSSMTPSvrWelcome);
end;


procedure TIdSMTPServer.InitializeCommandHandlers;
var LCmd : TIdCommandHandler;
begin
  inherited;
  LCmd := CommandHandlers.Add;
  LCmd.Command := 'EHLO';  {do not localize}
  LCmd.OnCommand := CommandEHLO;
  LCmd.NormalReply.NumericCode := 250;
  LCmd.ParseParams := True;
  SetEnhReply(LCmd.ExceptionReply ,451,Id_EHR_PR_OTHER_TEMP, 'Internal Error', False); {do not localize}

  LCmd := CommandHandlers.Add;
  LCmd.Command := 'HELO';  {do not localize}
  LCmd.OnCommand := CommandHELO;
  LCmd.NormalReply.NumericCode := 250;
  LCmd.ParseParams := True;
  SetEnhReply(LCmd.ExceptionReply ,451,Id_EHR_PR_OTHER_TEMP, 'Internal Error', False); {do not localize}

  LCmd := CommandHandlers.Add;
  LCmd.Command := 'AUTH';  {do not localize}
  LCmd.OnCommand := CommandAUTH;
  LCmd.ParseParams := True;
  SetEnhReply(LCmd.ExceptionReply ,451,Id_EHR_PR_OTHER_TEMP, 'Internal Error', False); {do not localize}

  LCmd := CommandHandlers.Add;
  // NOOP
  LCmd.Command := 'NOOP';    {Do not Localize}
  SetEnhReply(LCmd.NormalReply ,250,Id_EHR_GENERIC_OK,RSSMTPSvrOk, True);
  LCmd.OnCommand := CommandNOOP;
  SetEnhReply(LCmd.ExceptionReply ,451,Id_EHR_PR_OTHER_TEMP, 'Internal Error', False); {do not localize}

  LCmd := CommandHandlers.Add;
  // QUIT
  LCmd.Command := 'QUIT';    {Do not Localize}
  LCmd.CmdDelimiter := ' ';    {Do not Localize}
  LCmd.Disconnect := True;
  SetEnhReply(LCmd.NormalReply, 221, Id_EHR_GENERIC_OK, RSSMTPSvrQuit, False);
  LCmd.OnCommand := CommandQUIT;

  LCmd := CommandHandlers.Add;
  // RCPT <SP> TO:<forward-path> <CRLF>
  LCmd.Command := 'RCPT';    {Do not Localize}
  LCmd.CmdDelimiter := ' ';    {Do not Localize}
  LCmd.OnCommand := CommandRcpt;
  SetEnhReply(LCmd.ExceptionReply,550,Id_EHR_MSG_BAD_DEST,'', False);

  LCmd := CommandHandlers.Add;
  // MAIL <SP> FROM:<reverse-path> <CRLF>
  LCmd.Command := 'MAIL';    {Do not Localize}
  LCmd.CmdDelimiter := ' ';    {Do not Localize}
  LCmd.OnCommand := CommandMail;
  SetEnhReply(LCmd.ExceptionReply,451,Id_EHR_MSG_BAD_SENDER_ADDR,'', False);

  LCmd := CommandHandlers.Add;
  // DATA <CRLF>
  LCmd.Command := 'DATA'; {Do not Localize}
  LCmd.OnCommand := CommandDATA;
  SetEnhReply(LCmd.ExceptionReply, 451, Id_EHR_PR_OTHER_TEMP, 'Internal Error' , False); {do not localize}

  LCmd := CommandHandlers.Add;
  // RSET <CRLF>
  LCmd.Command := 'RSET';    {Do not Localize}
  LCmd.NormalReply.NumericCode := 250;
  LCmd.NormalReply.Text.Text := RSSMTPSvrOk;
  LCmd.OnCommand := CommandRSET;

  LCmd := CommandHandlers.Add;
  // STARTTLS <CRLF>
  LCmd.Command := 'STARTTLS';    {Do not Localize}
  LCmd.OnCommand := CommandStartTLS;
end;

procedure TIdSMTPServer.MustUseTLS(ASender: TIdCommand);
begin
    SetEnhReply(ASender.Reply,530,Id_EHR_USE_STARTTLS,RSSMTPSvrReqSTARTTLS, (ASender.Context as TIdSMTPServerContext).EHLO);
end;

procedure TIdSMTPServer.CommandAUTH(ASender: TIdCommand);
var
  Login: string;
begin
  //Note you can not use PIPELINING with AUTH
  TIdSMTPServerContext(ASender.Context).PipeLining := False;
  if TIdSMTPServerContext(ASender.Context).EHLO then // Only available with EHLO
  begin
    if not ((FUseTLS=utUseRequireTLS) and not TIdSMTPServerContext(ASender.Context).UsingTLS) then
    begin
      if Assigned( FOnUserLogin  ) then
      begin
        if Length(ASender.UnparsedParams) > 0 then
        begin
          Login := ASender.UnparsedParams;
          DoAuthLogin(ASender, Login)
        end
        else
        begin
          CmdSyntaxError(ASender);
        end;
      end;
    end
    else
    begin
      MustUseTLS(ASender);
    end;
  end;
end;

procedure TIdSMTPServer.CommandHELO(ASender: TIdCommand);
var LS : TIdSMTPServerContext;
begin
  LS := ASender.Context as TIdSMTPServerContext;
    if LS.SMTPState <> idSMTPNone then
    begin
      BadSequenceError(ASender);
      Exit;
    end;

  if Length(ASender.UnparsedParams) > 0 then
  begin
    ASender.Reply.SetReply(250,Format(RSSMTPSvrHello, [ASender.UnparsedParams]));
    LS.HELO := True;
    LS.SMTPState := idSMTPHelo;
    LS.HeloString := ASender.UnparsedParams;
  end
  else
  begin
    ASender.Reply.SetReply(501,RSSMTPSvrParmErr);
  end;
  LS.PipeLining := False;
end;

function TIdSMTPServer.DoAuthLogin(ASender: TIdCommand;
  const Login: string): Boolean;
var
  S: string;
  LUsername, LPassword: string;
  LAuthFailed: Boolean;
  LAccepted: Boolean;
  LS : TIdSMTPServerContext;
begin
  LS := ASender.Context as TIdSMTPServerContext;
  Result := False;
  LAuthFailed := False;
  TIdSMTPServerContext(ASender.Context).PipeLining := False;
  if UpperCase(Login) = 'LOGIN' then    {Do not Localize}
  begin // LOGIN USING THE LOGIN AUTH - BASE64 ENCODED
    s := 'Username:';    {Do not Localize}
    s := TIdEncoderMIME.EncodeString(s);
    //  s := SendRequest( '334 ' + s );    {Do not Localize}
    ASender.Reply.SetReply (334, s);    {Do not Localize}
    ASender.SendReply;
    s := Trim(ASender.Context.Connection.IOHandler.ReadLn);
    if s <> '' then    {Do not Localize}
    begin
      try
        s := TIdDecoderMIME.DecodeString(s);

        LUsername := s;
        // What? Endcode this string literal?
        s := 'Password:';    {Do not Localize}
        s := TIdEncoderMIME.EncodeString(s);
        //    s := SendRequest( '334 ' + s );    {Do not Localize}
        ASender.Reply.SetReply (334,s);    {Do not Localize}
        ASender.SendReply;
        s := Trim(ASender.Context.Connection.IOHandler.ReadLn);
        if Length(s) = 0 then
        begin
          LAuthFailed := True;
        end
        else
        begin
          LPassword := TIdDecoderMIME.DecodeString(s);
        end;
      // when TIdDecoderMime.DecodeString(s) raise a exception,catch it and set AuthFailed as true
      except
        LAuthFailed := true;
      end;
    end
    else
    begin
      LAuthFailed := True;
    end;
  end;

  // Add other login units here

  if LAuthFailed then
  begin
    Result := False;
    AuthFailed(ASender);
  end
  else
  begin
    LAccepted := False;
    if Assigned(fOnUserLogin) then
    begin
      fOnUserLogin(LS,  LUsername, LPassword, LAccepted);
    end
    else
    begin
      LAccepted := True;
    end;
    LS.LoggedIn := LAccepted;
    LS.Username := LUsername;
    if not LAccepted then
    begin
      AuthFailed(ASender);
    end
    else
    begin
      SetEnhReply(ASender.Reply,235,Id_EHR_SEC_OTHER_OK,' welcome ' + Trim(LUsername), (ASender.Context as TIdSMTPServerContext).EHLO);    {Do not Localize}
      ASender.SendReply;
    end;
  end;
end;

procedure TIdSMTPServer.SetEnhReply(AReply: TIdReply;
  const ANumericCode: Integer; const AEnhReply, AText: String; const IsEHLO: Boolean);
begin
  if (AReply is TIdReplySMTP) then
   if IsEHLO then begin
     (AReply as TIdReplySMTP).SetEnhReply(ANumericCode, AEnhReply, AText);
   end else begin
     AReply.SetReply(ANumericCode, AText);
   end;
end;

procedure TIdSMTPServer.AuthFailed(ASender: TIdCommand);
begin
  SetEnhReply(ASender.Reply,535,Id_EHR_SEC_OTHER_PERM,RSSMTPSvrAuthFailed, (ASender.Context as TIdSMTPServerContext).EHLO);
  ASender.SendReply;
end;

procedure TIdSMTPServer.AddrInvalid(ASender: TIdCommand; const AAddress : String = '');
begin
  SetEnhReply(ASender.Reply,500,Id_EHR_MSG_BAD_DEST, Format(RSSMTPSvrAddressError, [AAddress]), (ASender.Context as TIdSMTPServerContext).EHLO);
end;

procedure TIdSMTPServer.AddrNotWillForward(ASender: TIdCommand; const AAddress : String = ''; const ATo : String = '');
begin
  SetEnhReply(ASender.Reply,521,Id_EHR_SEC_DEL_NOT_AUTH,Format(RSSMTPUserNotLocal, [AAddress]), (ASender.Context as TIdSMTPServerContext).EHLO);
end;

procedure TIdSMTPServer.AddrValid(ASender: TIdCommand; const AAddress : String = '');
begin
  SetEnhReply(ASender.Reply,250, Id_EHR_MSG_VALID_DEST,Format(RSSMTPSvrAddressOk, [AAddress]), (ASender.Context as TIdSMTPServerContext).EHLO);
end;

procedure TIdSMTPServer.AddrNoRelaying(ASender: TIdCommand;
  const AAddress: String);
begin
  SetEnhReply(ASender.Reply,550, Id_EHR_SEC_DEL_NOT_AUTH,Format( RSSMTPSvrNoRelay, [AAddress]), (ASender.Context as TIdSMTPServerContext).EHLO);
end;

procedure TIdSMTPServer.AddrWillForward(ASender: TIdCommand; const AAddress : String = '');
begin
// Note, changed format from RSSMTPUserNotLocal as it now has two %s.
  SetEnhReply(ASender.Reply,251, Id_EHR_MSG_VALID_DEST,Format(RSSMTPUserNotLocalNoAddr, [AAddress]), (ASender.Context as TIdSMTPServerContext).EHLO);
end;

procedure TIdSMTPServer.AddrTooManyRecipients(ASender: TIdCommand);
begin
  SetEnhReply(ASender.Reply,250,Id_EHR_PR_TOO_MANY_RECIPIENTS_PERM, RSSMTPTooManyRecipients, (ASender.Context as TIdSMTPServerContext).EHLO);
end;

procedure TIdSMTPServer.AddrDisabledPerm(ASender: TIdCommand;
  const AAddress: String);
begin
  SetEnhReply(ASender.Reply,550,Id_EHR_MB_DISABLED_PERM,Format(RSSMTPAccountDisabled,[AAddress]), (ASender.Context as TIdSMTPServerContext).EHLO);
end;

procedure TIdSMTPServer.AddrDisabledTemp(ASender: TIdCommand;
  const AAddress: String);
begin
  SetEnhReply(ASender.Reply,550,Id_EHR_MB_DISABLED_TEMP,Format(RSSMTPAccountDisabled,[AAddress]), (ASender.Context as TIdSMTPServerContext).EHLO);
end;

procedure TIdSMTPServer.MailSubmitLimitExceeded(ASender: TIdCommand);
begin
  SetEnhReply(ASender.Reply,552,Id_EHR_MB_MSG_LEN_LIMIT,RSSMTPMsgLenLimit, (ASender.Context as TIdSMTPServerContext).EHLO);
  ASender.SendReply;
end;

procedure TIdSMTPServer.MailSubmitLocalProcessingError(
  ASender: TIdCommand);
begin
  SetEnhReply(ASender.Reply,451,Id_EHR_MD_OTHER_TRANS,RSSMTPLocalProcessingError, (ASender.Context as TIdSMTPServerContext).EHLO);
  ASender.SendReply;
end;

procedure TIdSMTPServer.MailSubmitOk(ASender: TIdCommand);
begin
  SetEnhReply(ASender.Reply,250,'',RSSMTPSvrOk,(ASender.Context as TIdSMTPServerContext).EHLO);
  ASender.SendReply;
end;

procedure TIdSMTPServer.MailSubmitStorageExceededFull(ASender: TIdCommand);
begin
  SetEnhReply(ASender.Reply,552,Id_EHR_MB_FULL,RSSMTPSvrExceededStorageAlloc,(ASender.Context as TIdSMTPServerContext).EHLO);
  ASender.SendReply;
end;

procedure TIdSMTPServer.MailSubmitSystemFull(ASender: TIdCommand);
begin
  SetEnhReply(ASender.Reply,452,Id_EHR_MD_MAIL_SYSTEM_FULL,RSSMTPSvrInsufficientSysStorage,(ASender.Context as TIdSMTPServerContext).EHLO);
  ASender.SendReply;
end;

procedure TIdSMTPServer.MailSubmitTransactionFailed(ASender: TIdCommand);
begin
  SetEnhReply(ASender.Reply,554,Id_EHR_MB_OTHER_STATUS_TRANS,RSSMTPSvrTransactionFailed,(ASender.Context as TIdSMTPServerContext).EHLO);
  ASender.SendReply;
end;

procedure TIdSMTPServer.MailFromAccept(ASender: TIdCommand; const AAddress : String = '');
begin
  SetEnhReply(ASender.Reply,250,Id_EHR_MSG_OTH_OK, Format(RSSMTPSvrAddressOk,[AAddress]),(ASender.Context as TIdSMTPServerContext).EHLO);
end;

procedure TIdSMTPServer.MailFromReject(ASender: TIdCommand; const AAddress : String = '');
begin
  SetEnhReply(ASender.Reply,250,Id_EHR_SEC_DEL_NOT_AUTH, Format(RSSMTPSvrNotPermitted,[AAddress]),(ASender.Context as TIdSMTPServerContext).EHLO);
end;

procedure TIdSMTPServer.NoHello(ASender: TIdCommand);
begin
  SetEnhReply(ASender.Reply,501,Id_EHR_PR_OTHER_PERM, RSSMTPSvrNoHello,(ASender.Context as TIdSMTPServerContext).EHLO);
end;

procedure TIdSMTPServer.CommandMAIL(ASender: TIdCommand);
var