More Detail: SMTP Server / Outlook Issues

Giganews Newsgroups
Subject: More Detail: SMTP Server / Outlook Issues
Posted by:  Pierre Roux (pier…@infofx.co.za)
Date: Wed, 7 Apr 2004

More detail on the problem:
Ok... here goes:

Tracing the execution, the code would execute fine up to the second/third
message send by the client.  After this message, execution ends after the
OnCommandRCPT Event or over the OnReceiveMessageParsed Event.  After a
while, the client times out, and the connection closes gracefully.

Code:
procedure TfrmMain.SMTPServerCheckUser(ASender: TIdCommand;
  var Accept: Boolean; Username, Password: String);
begin
  Accept := True;
end;

procedure TfrmMain.SMTPServerCommandAUTH(ASender: TIdCommand);
begin
  Log (ltControl, 'AUTH');
end;

procedure TfrmMain.SMTPServerCommandEXPN(ASender: TIdCommand);
begin
  Log (ltControl, 'EXPN');
end;

procedure TfrmMain.SMTPServerCommandHELP(ASender: TIdCommand);
begin
  Log (ltControl, 'HELP');
end;

procedure TfrmMain.SMTPServerCommandMAIL(const ASender: TIdCommand;
  var Accept: Boolean; EMailAddress: String);
begin
  Log (ltControl, 'MAIL '+ EMailAddress);
  Accept := TRUE;
end;

procedure TfrmMain.SMTPServerCommandRCPT(const ASender: TIdCommand;
  var Accept, ToForward: Boolean; EMailAddress: String;
  var CustomError: String);
var
  sMailFileDir  :  String;
  ServerAdmin    :  TServerAdmin;
begin
  ServerAdmin    :=  TServerAdmin.Create (sBaseDir);
  Log (ltControl, 'RCPT ' + EMailAddress);

  if ServerAdmin.GetUserDir(EMailAddress, sMailFileDir) then
    begin
    Accept      := TRUE;
    ToForward  := FALSE;
    end
  else
    begin
    Accept      := TRUE;
    ToForward  := TRUE;    // Debug Only
    end;
  ServerAdmin.Free;
end;

procedure TfrmMain.SMTPServerCommandSAML(ASender: TIdCommand);
begin
  Log (ltControl, 'SAML');
end;

procedure TfrmMain.SMTPServerCommandSEND(ASender: TIdCommand);
begin
  Log (ltControl, 'SEND');
end;

procedure TfrmMain.SMTPServerCommandSOML(ASender: TIdCommand);
begin
  Log (ltControl, 'SOML');
end;

procedure TfrmMain.SMTPServerCommandTURN(ASender: TIdCommand);
begin
  Log (ltControl, 'TURN');
end;

procedure TfrmMain.SMTPServerCommandVRFY(ASender: TIdCommand);
begin
  Log (ltControl, 'VRFY');
end;

procedure TfrmMain.SMTPServerReceiveMessageParsed(ASender: TIdCommand;
  var AMsg: TIdMessage; RCPT: TIdEMailAddressList;
  var CustomError: String);
var
  ServerAdmin    :  TServerAdmin;
  sMailFileName,
  sMailFileDir  :  String;
  ilCount        :  Integer;
begin
  ServerAdmin := TServerAdmin.Create (sBaseDir);

  Log (ltControl, 'DATA .');
  for ilCount := 0 to RCPT.Count - 1 do
    begin
    if ServerAdmin.GetUserDir(RCPT.Items[ilCount].Address, sMailFileDir)
then
        begin // Accept Locally
        sMailFileName := sMailFileDir+'\'+FileNameRnd('msg');
        if not FileExists(sMailFileName) then
          AMsg.SaveToFile(sMailFileName, False)
        else
          Log (ltError, 'SMTP (.) : Could not save E-Mail to Account.');
        end
    else
        begin // Accept for Relay
        sMailFileName := sBaseDir + '\smtp\' + FileNameRnd('msg');
        if not FileExists(sMailFileName) then
          AMsg.SaveToFile(sMailFileName, False)
        else
          Log (ltError, 'SMTP (.) : Could not save E-Mail to Forward
Queue.');
        end;
    end;

  ServerAdmin.Free;

end;

procedure TfrmMain.SMTPServerException(AThread: TIdPeerThread;
  AException: Exception);
begin
  Log(ltError, ' SMTP Failure: ' + AException.Message );
end;

I use my own logging, never been able to get the Id logging to work in a
multi-threaded/server environment.

Replies

None

In response to

SMTP Server / Outlook Issues posted by Pierre Roux on Wed, 7 Apr 2004