idsmtpserver.pas

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

  EMailAddress: TIdEMailAddressItem;
  LS : TIdSMTPServerContext;
  LM : TIdMailFromReply;
begin
  //Note that unlike other protocols, it might not be possible
  //to completely disable MAIL FROM for people not using SSL
  //because SMTP is also used from server to server mail transfers.
  LS := ASender.Context as TIdSMTPServerContext;
  if LS.HELO Or LS.EHLO then // Looking for either HELO or EHLO
  begin

    //reset all information
    LS.From := '';    {Do not Localize}
    LS.RCPTList.Clear;

    if Uppercase(Copy(ASender.UnparsedParams, 1, 5)) = 'FROM:' then    {Do not Localize}
    begin
      EMailAddress := TIdEMailAddressItem.Create(nil);
      Try
        EMailAddress.Text := Trim(Copy(ASender.UnparsedParams, 6,Length(ASender.UnparsedParams)));
        LM := mAccept;
        if Assigned(FOnMailFrom) then
        begin
          FOnMailFrom(LS,EMailAddress.Address,LM);
        end;
        case LM of
          mAccept :
          begin
            MailFromAccept(ASender,EMailAddress.Address);
            LS.From := EMailAddress.Address;
            LS.SMTPState := idSMTPMail;
          end;
          mReject :
          begin
            MailFromReject(ASender,EMailAddress.Text);
          end;
        end;
      Finally
       FreeAndNil(EMailAddress);
      End;
    end
    else
    begin
      InvalidSyntax(ASender);
    end;
  end
  else // No EHLO / HELO was received
  begin
    NoHello(ASender);
  end;
  TIdSMTPServerContext(ASender.Context).CheckPipeLine;
end;

procedure TIdSMTPServer.InvalidSyntax(ASender: TIdCommand);
begin
  SetEnhReply(ASender.Reply,501,Id_EHR_PR_INVALID_CMD_ARGS,RSPOP3SvrInvalidSyntax,(ASender.Context as TIdSMTPServerContext).EHLO);
end;

procedure TIdSMTPServer.CommandRCPT(ASender: TIdCommand);
var
  EMailAddress: TIdEMailAddressItem;
  LS : TIdSMTPServerContext;
  LAction : TIdRCPToReply;
  LForward : String;
begin
  LForward := '';
  LS := ASender.Context as TIdSMTPServerContext;
  if (LS.SMTPState <> idSMTPMail) AND (LS.SMTPState <> idSMTPRcpt) then
  begin
    BadSequenceError(ASender);
    Exit;
  end;

  if LS.HELO or LS.EHLO then
  begin
    if (Uppercase(Copy(ASender.UnparsedParams, 1, 3)) = 'TO:') then    {Do not Localize}
    begin
      LAction :=  rRelayDenied;
      //do not change this in the OnRcptTo event unless one of the following
      //things is TRUE:
      //
      //1.  The user authenticated to the SMTP server
      //
      //2.  The user has is from an IP address being served by the SMTP server.
      //    Test the IP address for this.
      //
      //3.  Another SMTP server outside of your network is sending E-Mail to a
      //    user on YOUR system.
      //
      //The reason is that you do not want to relay E-Messages for outsiders
      //if the E-Mail is from outside of your network.  Be very CAREFUL.  Otherwise,
      //you have a security hazard that spammers can abuse.
      EMailAddress := TIdEMailAddressItem.Create(nil);
      try
        EMailAddress.Text := Trim(Copy(ASender.UnparsedParams, 4,
          Length(ASender.UnparsedParams)));
        if Assigned(FOnRcptTo) then
        begin
          FOnRcptTo(LS,EMailAddress.Address,LAction,LForward);
          case LAction of
            rAddressOk :
            begin
              AddrValid(ASender, EMailAddress.Address);
              LS.RCPTList.Add.Text := EMailAddress.Text;
              LS.SMTPState := idSMTPRcpt;
            end;
            rRelayDenied :
            begin
              AddrNoRelaying( ASender, EMailAddress.Address );
            end;
            rWillForward :
            begin
              AddrWillForward( ASender, EMailAddress.Address );
              LS.RCPTList.Add.Text := EMailAddress.Text;
              LS.SMTPState := idSMTPRcpt;
            end;
            rNoForward : AddrNotWillForward(ASender, EMailAddress.Address, LForward);
            rTooManyAddresses : AddrTooManyRecipients(ASender);
            rDisabledPerm : AddrDisabledPerm(ASender, EMailAddress.Address);
            rDisabledTemp : AddrDisabledTemp(ASender, EMailAddress.Address);
          else
            AddrInvalid(ASender, EMailAddress.Address);
          end;
        end
        else
        begin
          raise EIdSMTPServerNoRcptTo.Create(RSSMTPNoOnRcptTo);
        end;
      finally
       FreeAndNil(EMailAddress);
      end;
    end
    else
    begin
      SetEnhReply(ASender.Reply,501,Id_EHR_PR_SYNTAX_ERR,RSSMTPSvrParmErrRcptTo,(ASender.Context as TIdSMTPServerContext).EHLO);
    end;
  end
  else // No EHLO / HELO was received
  begin
    NoHello(ASender);
  end;
  TIdSMTPServerContext(ASender.Context).CheckPipeLine;
end;

procedure TIdSMTPServer.CommandSTARTTLS(ASender: TIdCommand);
var LIO : TIdSSLIOHandlerSocketBase;
  LS : TIdSMTPServerContext;
begin
  LS := ASender.Context as TIdSMTPServerContext;
  if FUseTLS in ExplicitTLSVals then begin
    if TIdSMTPServerContext(ASender.Context).UsingTLS then begin // we are already using TLS
      Self.BadSequenceError(ASender);
      Exit;
    end;
    SetEnhReply(ASender.Reply,220,Id_EHR_GENERIC_OK,RSSMTPSvrReadyForTLS, (ASender.Context as TIdSMTPServerContext).EHLO);

    LS.PipeLining := False;
    LIO := ASender.Context.Connection.IOHandler as TIdSSLIOHandlerSocketBase;
    LIO.Passthrough := False;
    LS.SMTPState:=idSMTPNone; // to reset the state
    LS.HELO:=false;           //
    LS.EHLO:=false;           //
    LS.Username := '';        //
    LS.Password := '';         //
    LS.LoggedIn:=false;       //
  end else begin
    CmdSyntaxError(ASender);
    TIdSMTPServerContext(ASender.Context).PipeLining := False;
  end;
end;

procedure TIdSMTPServer.CommandNOOP(ASender: TIdCommand);
begin
//we just use the default NOOP and only clear pipelining for synchronization
  TIdSMTPServerContext(ASender.Context).PipeLining := False;
end;

procedure TIdSMTPServer.CommandQUIT(ASender: TIdCommand);
begin
//clear pipelining before exit
  TIdSMTPServerContext(ASender.Context).PipeLining := False;
  ASender.SendReply;
end;

procedure TIdSMTPServer.CommandRSET(ASender: TIdCommand);
var LS : TIdSMTPServerContext;
begin
  LS := ASender.Context as TIdSMTPServerContext;
  LS.RCPTList.Clear;
  LS.From := '';    {Do not Localize}

  if LS.Ehlo or LS.Helo then
  begin
      LS.SMTPState := idSMTPHelo;
  end
  else
  begin
      LS.SMTPState := idSMTPNone;
  end;

  LS.CheckPipeLine;
end;

procedure TIdSMTPServer.CommandDATA(ASender: TIdCommand);
var
  LS : TIdSMTPServerContext;
  LStream: TStream;
  AMsg : TStream;
  LAction : TIdDataReply;
  ReceivedString : String;
begin
  ReceivedString := IdSMTPSvrReceivedString;
  LS := ASender.Context as TIdSMTPServerContext;
  if (LS.SMTPState <> idSMTPRcpt) then
  begin
    BadSequenceError(ASender);
    Exit;
  end;
  if LS.HELO or LS.EHLO then
  begin
    SetEnhReply(ASender.Reply,354, '',RSSMTPSvrStartData,(ASender.Context as TIdSMTPServerContext).EHLO);
    ASender.SendReply;
    LS.PipeLining := False;
    LStream := TMemoryStream.Create;
    AMsg    := TMemoryStream.Create;
    try
      LAction := dOk;
      ASender.Context.Connection.IOHandler.Capture(LStream, '.', True);    {Do not Localize}
      LStream.Position := 0;
      if Assigned(OnReceived) then
      begin
        FOnReceived(LS, ReceivedString);
      end;
      if LS.FinalStage then
       Begin
        // If at the final delivery stage, add the Return-Path line for the received MAIL FROM line.
        WriteStringToStream(AMsg, 'Received-Path: <' + LS.From + '>' + EOL); {do not localize}
       End;

      if ReceivedString <> '' then
       Begin
        // Parse the ReceivedString and replace any of the special 'tokens'
        ReceivedString := StringReplace(ReceivedString, '$hostname', GStack.HostByAddress(ASender.Context.Binding.PeerIP), [rfReplaceall]); {do not localize}
        ReceivedString := StringReplace(ReceivedString, '$ipaddress', ASender.Context.Binding.PeerIP, [rfReplaceall]); {do not localize}
        ReceivedString := StringReplace(ReceivedString, '$helo', LS.HeloString, [rfReplaceall]);
        if LS.EHLO then
         ReceivedString := StringReplace(ReceivedString, '$protocol', 'esmtp', [rfReplaceall]) {do not localize}
        else
         ReceivedString := StringReplace(ReceivedString, '$protocol', 'smtp', [rfReplaceall]); {do not localize}
        ReceivedString := StringReplace(ReceivedString, '$servername', FServerName, [rfReplaceall]);
        ReceivedString := StringReplace(ReceivedString, '$svrhostname', GStack.HostByAddress(ASender.Context.Binding.IP), [rfReplaceAll]);
        ReceivedString := StringReplace(ReceivedString, '$svripaddress', ASender.Context.Binding.IP, [rfReplaceAll]);

        WriteStringToStream(AMsg, ReceivedString + EOL);
       End;
      AMsg.CopyFrom(LStream, 0); // Copy the contents that was captured to the new stream.
      if Assigned(OnMsgReceive) then
      begin
        FOnMsgReceive(LS,AMsg,LAction);
      end;
    finally
      FreeAndNil(LStream);
      FreeAndNil(AMsg);
    end;
    case LAction of
    dOk                   : MailSubmitOk(ASender); //accept the mail message
    dMBFull               : MailSubmitStorageExceededFull(ASender); //Mail box full
    dSystemFull           : MailSubmitSystemFull(ASender); //no more space on server
    dLocalProcessingError : MailSubmitLocalProcessingError(ASender); //local processing error
    dTransactionFailed    : MailSubmitTransactionFailed(ASender); //transaction failed
    dLimitExceeded        : MailSubmitLimitExceeded(ASender); //exceeded administrative limit
    end;
  end
  else // No EHLO / HELO was received
  begin
    Self.NoHello(ASender);
  end;
  TIdSMTPServerContext(ASender.Context).PipeLining := False;
end;

{ TIdSMTPServerContext }

procedure TIdSMTPServerContext.CheckPipeLine;
begin
  if Connection.IOHandler.InputBufferIsEmpty=False then
  begin
    PipeLining := True;
  end;
end;

constructor TIdSMTPServerContext.Create(AConnection: TIdTCPConnection;
  AYarn: TIdYarn; AList: TThreadList);
begin
  inherited;
  SMTPState := idSMTPNone;
  From:='';
  HELO:=false;
  EHLO:=false;
  Username:='';
  Password:='';
  LoggedIn:=false;
  FreeAndNil(FRCPTList);
  FRCPTList := TIdEMailAddressList.Create(nil);
end;

destructor TIdSMTPServerContext.Destroy;
begin
  FreeAndNil(FRCPTList);
  inherited;
end;

function TIdSMTPServerContext.GetUsingTLS: boolean;
begin
  Result:=Connection.IOHandler is TIdSSLIOHandlerSocketBase;
  if result then
  begin
    Result:=not TIdSSLIOHandlerSocketBase(Connection.IOHandler).PassThrough;
  end;
end;

procedure TIdSMTPServerContext.SetPipeLining(const AValue: Boolean);
begin
  if AValue and (PipeLining = False) then
  begin
    Connection.IOHandler.WriteBufferOpen;
  end
  else
  begin
    if (AValue=False) and PipeLining then
    begin
      Connection.IOHandler.WriteBufferClose;
    end;
  end;
  FPipeLining := AValue;
end;

end.