idpop3server.pas

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

    OnCommand := CommandCAPA;
  end;

end;

{ Command Handler Functions here }

procedure TIdPOP3Server.CommandUser(ASender: TIdCommand);
Var
  LThread: TIdPOP3ServerContext;
begin
  LThread := TIdPOP3ServerContext(ASender.Context );
  if (FUseTLS =utUseRequireTLS) and ((ASender.Context.Connection.IOHandler as TIdSSLIOHandlerSocketBase).PassThrough=True) then
  begin
    MustUseTLS(ASender);
  end
  else
  begin
    if ASender.Params.Count > 0 then
    begin
        LThread.Username := ASender.Params.Strings[0];
    end;
    ASender.Reply.SetReply(OK, RSPOP3SvrPasswordRequired);
  end;
end;

procedure TIdPOP3Server.CommandPass(ASender: TIdCommand);
Var
  LThread: TIdPOP3ServerContext;
begin
  LThread := TIdPOP3ServerContext(ASender.Context);
  if (FUseTLS =utUseRequireTLS) and ((ASender.Context.Connection.IOHandler as TIdSSLIOHandlerSocketBase).PassThrough=True) then
  begin
    MustUseTLS(ASender);
  end
  else
  begin
    if ASender.Params.Count > 0 then
    begin
      LThread.Password := ASender.Params.Strings[0];
    end;
    if Assigned(CheckUser) then
    begin
      CheckUser(ASender.Context, LThread);
    end;
  // User to set return state of LThread.State as required.

    If LThread.State <> Trans Then
    begin
      ASender.Reply.SetReply(ERR,RSPOP3SvrLoginFailed);
    end
    Else
    begin
      ASender.Reply.SetReply(OK,RSPOP3SvrLoginOk);
    end;
  end;
end;

procedure TIdPOP3Server.CommandList(ASender: TIdCommand);
Var
  LThread: TIdPOP3ServerContext;
begin
  LThread := TIdPOP3ServerContext(ASender.Context);
  If LThread.State = Trans Then
   Begin
    If Assigned(fCommandList) Then
    begin
      OnList(ASender, StrToIntDef(Trim(ASender.Params.Text), -1));
    end
    Else
    begin
      ASender.Reply.SetReply(ERR,Format(RSPOP3SVRNotHandled, ['LIST'])); {do not localize}
    end;
  End
  Else
  begin
    ASender.Reply.SetReply(ERR,RSPOP3SvrLoginFirst);
  end;
end;

procedure TIdPOP3Server.CommandRetr(ASender: TIdCommand);
Var
  LThread: TIdPOP3ServerContext;
begin
  LThread := TIdPOP3ServerContext(ASender.Context);
  If LThread.State = Trans Then
   Begin
    If Assigned(fCommandRetr) Then
    begin
      OnRetr(ASender, StrToIntDef(Trim(ASender.Params.Text), -1));
    end
    Else
    begin
      ASender.Reply.SetReply(ERR,Format(RSPOP3SVRNotHandled, ['RETR'])); {do not localize}
    end;
  End
  Else
  begin
    ASender.Reply.SetReply(ERR,RSPOP3SvrLoginFirst);
  end;
end;

procedure TIdPOP3Server.CommandDele(ASender: TIdCommand);
Var
  LThread: TIdPOP3ServerContext;
begin
  LThread := TIdPOP3ServerContext(ASender.Context);
  If LThread.State = Trans Then
  Begin
    If Assigned(fCommandDele) Then
    Begin
      Try
        StrToInt(Trim(ASender.Params.Text));
        OnDele(ASender, StrToInt(Trim(ASender.Params.Text)))
      Except
        ASender.Reply.SetReply(ERR,RSPOP3SvrInvalidMsgNo);
      End;
    End
    Else
    begin
      ASender.Reply.SetReply(ERR,Format(RSPOP3SVRNotHandled, ['DELE'])); {do not localize}
    end;
  End
  Else
  begin
   ASender.Context.Connection.IOHandler.WriteLn(ERR+' '+RSPOP3SvrLoginFirst);
  end;
end;

procedure TIdPOP3Server.CommandQuit(ASender: TIdCommand);
Var
  LThread: TIdPOP3ServerContext;
begin
  LThread := TIdPOP3ServerContext(ASender.Context);
  If LThread.State = Trans Then
  Begin
    If Assigned(fCommandQuit) Then
    begin
      OnQuit(ASender)
    end;
  End;
end;

procedure TIdPOP3Server.CommandAPOP(ASender: TIdCommand);
Var
 LThread: TIdPOP3ServerContext;
 LValidPassword : String;
 LValidHash : String;
begin
  LThread := TIdPOP3ServerContext(ASender.Context);
  If LThread.State = Auth Then
  Begin
    if (FUseTLS =utUseRequireTLS) and ((ASender.Context.Connection.IOHandler as TIdSSLIOHandlerSocketBase).PassThrough=True) then
    begin
      MustUseTLS(ASender);
    end
    else
    begin
      If Assigned(fCommandAPOP) Then
      Begin
       OnAPOP(ASender, ASender.Params.Strings[0], LValidPassword);
       with TIdHashMessageDigest5.Create do
       try
         LValidHash := LowerCase(TIdHash128.AsHex(
           HashValue(LThread.APOP3Challenge + LValidPassword)));
         if (LValidHash =ASender.Params[1]) then
         begin
           LThread.State := Trans;
         end;

       finally
         free;
       end;

       // User to set return state of LThread.State as required.
       If LThread.State <> Trans Then
       begin
         ASender.Reply.SetReply(ST_ERR,RSPOP3SvrLoginFailed);
       end
       else
       begin
         ASender.Reply.SetReply(ST_OK,RSPOP3SvrLoginOk);
       end;
      End
      Else
      begin
        ASender.Reply.SetReply(ST_ERR,Format(RSPOP3SVRNotHandled, ['APOP'])); {do not localize}
      end;
    end;
  End
  Else
  begin
    ASender.Reply.SetReply(ST_ERR,RSPOP3SvrWrongState);
  end;
end;

procedure TIdPOP3Server.CommandStat(ASender: TIdCommand);
Var
  LThread: TIdPOP3ServerContext;
begin
  LThread := TIdPOP3ServerContext(ASender.Context);
  If LThread.State = Trans Then
  Begin
    If Assigned(fCommandStat) Then
    begin
      OnStat(ASender);
    end
    Else
    begin
      ASender.Reply.SetReply(ST_ERR,Format(RSPOP3SVRNotHandled, ['STAT'])); {do not localize}
    end;
  End
  Else
  begin
    ASender.Reply.SetReply(ST_ERR,RSPOP3SvrLoginFirst);
  end;
end;

procedure TIdPOP3Server.CommandRset(ASender: TIdCommand);
Var
  LThread: TIdPOP3ServerContext;
begin
  LThread := TIdPOP3ServerContext(ASender.Context);
  If LThread.State = Trans Then
  Begin
    If Assigned(fCommandRSET) Then
    begin
      OnRset(ASender);
    end
    Else
    begin
      ASender.Reply.SetReply(ST_ERR, Format(RSPOP3SVRNotHandled, ['RSET']));  {do not localize}
    end;
  End
  Else
  begin
    ASender.Reply.SetReply(ST_ERR, RSPOP3SvrLoginFirst);
  end;
end;

procedure TIdPOP3Server.CommandTop(ASender: TIdCommand);
Var
  LThread: TIdPOP3ServerContext;
begin
  LThread := TIdPOP3ServerContext(ASender.Context);
  If LThread.State = Trans Then
  Begin
    If Assigned(fCommandTop) Then
    Begin
      If (StrToIntDef(Trim(ASender.Params.Strings[0]), -1) <> -1) AND (StrToIntDef(Trim(ASender.Params.Strings[1]), -1) <> -1) Then
      begin
        OnTop(ASender, StrToInt(ASender.Params.Strings[0]), StrToInt(ASender.Params.Strings[1]))
      end
      Else
      begin
         ASender.Reply.SetReply(ST_ERR, RSPOP3SvrInvalidSyntax);
      end;
    End
    Else
    begin
      ASender.Reply.SetReply(ST_ERR, Format(RSPOP3SVRNotHandled, ['TOP'])); {do not localize}
    end;
  End
  Else
  begin
    ASender.Reply.SetReply(ST_ERR, RSPOP3SvrLoginFirst);
  end;
end;

procedure TIdPOP3Server.CommandUIDL(ASender: TIdCommand);
Var
  LThread: TIdPOP3ServerContext;
begin
  LThread := TIdPOP3ServerContext(ASender.Context);
  If LThread.State = Trans Then
  Begin
    If Assigned(fCommandUidl) Then
    begin
       OnUidl(ASender, StrToIntDef(Trim(ASender.Params.Text), -1))
    end
    Else
    begin
      ASender.Reply.SetReply(ST_ERR, Format(RSPOP3SVRNotHandled, ['UIDL']));  {do not localize}
    end
  End
  Else
  begin
    ASender.Reply.SetReply(ST_ERR, RSPOP3SvrLoginFirst);
  end;
end;

procedure TIdPOP3Server.CommandSTLS(ASender: TIdCommand);
var LIO : TIdSSLIOHandlerSocketBase;
begin
  if (IOHandler is TIdServerIOHandlerSSLBase) and (FUseTLS in ExplicitTLSVals) then begin
    if TIdPOP3ServerContext(ASender.Context).UsingTLS then begin // we are already using TLS
      ASender.Reply.SetReply(ST_ERR, RSPOP3SvrNotPermittedWithTLS);    {Do not Localize}
      Exit;
    end;
    if TIdPOP3ServerContext(ASender.Context).State<>Auth then begin //STLS only allowed in auth-state
      ASender.Reply.SetReply(ST_ERR, RSPOP3SvrNotInThisState);    {Do not Localize}
      Exit;
    end;
    ASender.Reply.SetReply(ST_OK, RSPOP3SvrBeginTLSNegotiation);
    LIO := ASender.Context.Connection.IOHandler as TIdSSLIOHandlerSocketBase;
    LIO.Passthrough := False;
  end else begin
    ASender.Reply.SetReply(ST_ERR, Format(RSPOP3SVRNotHandled, ['STLS']));    {do not localize}
  end;
end;

procedure TIdPOP3Server.CommandCAPA(ASender: TIdCommand);
begin
  ASender.Reply.SetReply(ST_OK, RSPOP3SvrCapaList);
  ASender.SendReply;
  If Assigned(fCommandUidl) Then
    ASender.Context.Connection.IOHandler.WriteLn('UIDL'); {do not localize}
  If (IOHandler is TIdServerIOHandlerSSLBase) and
    (FUseTLS in ExplicitTLSVals) Then
  begin
    ASender.Context.Connection.IOHandler.WriteLn('STLS'); {do not localize}
  end;
  ASender.Context.Connection.IOHandler.WriteLn('USER'); {do not localize}
//  ASender.Context.Connection.IOHandler.WriteLn('SASL ......');   // like 'SASL CRAM-MD5 KERBEROS_V4'
  ASender.Context.Connection.IOHandler.WriteLn('.');
end;

{ Constructor / Destructors }

procedure TIdPOP3Server.InitComponent;
begin
  inherited;
  FContextClass := TIdPOP3ServerContext;
  FRegularProtPort := IdPORT_POP3;
  FImplicitTLSProtPort := IdPORT_POP3S;
  DefaultPort := IdPORT_POP3;
end;

destructor TIdPOP3Server.Destroy;
begin
  inherited;
end;

function TIdPOP3Server.CreateExceptionReply: TIdReply;
begin
  Result := TIdReplyPOP3.Create(nil, ReplyTexts);
  Result.SetReply(ERR, RSPOP3SvrInternalError);
end;

function TIdPOP3Server.CreateGreeting: TIdReply;
begin
  Result := TIdReplyPOP3.Create(nil, ReplyTexts);
  Result.SetReply(OK, RSPOP3SvrWelcome);
end;

function TIdPOP3Server.CreateHelpReply: TIdReply;
begin
  Result := TIdReplyPOP3.Create(nil, ReplyTexts);
  Result.SetReply(OK, RSPOP3SvrHelpFollows);
end;

function TIdPOP3Server.CreateMaxConnectionReply: TIdReply;
begin
  Result := TIdReplyPOP3.Create(nil, ReplyTexts);
  Result.SetReply(ERR, RSPOP3SvrTooManyCons);
end;

function TIdPOP3Server.CreateReplyUnknownCommand: TIdReply;
begin
  Result := TIdReplyPOP3.Create(nil, ReplyTexts);
  Result.SetReply(ERR, RSPOP3SvrUnknownCmd);
end;

function TIdPOP3Server.GetReplyClass: TIdReplyClass;
begin
  Result := TIdReplyPOP3;
end;

function TIdPOP3Server.GetRepliesClass: TIdRepliesClass;
begin
  Result := TIdRepliesPOP3;
end;

{ TIdPOP3ServerContext }

constructor TIdPOP3ServerContext.Create(
  AConnection: TIdTCPConnection;
  AYarn: TIdYarn;
  AList: TThreadList = nil
  );
begin
  inherited;
  FUser := '';
  fState := Auth;
  fPassword := '';
end;

destructor TIdPOP3ServerContext.Destroy;
begin
  inherited;
end;

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

procedure TIdPOP3Server.MustUseTLS(ASender: TIdCommand);
begin
  ASender.Context.Connection.IOHandler.WriteLn(ERR+' '+RSPOP3SvrMustUseSTLS);
  ASender.Disconnect := True;
end;

procedure TIdPOP3Server.SendGreeting(AContext: TIdContext;
  AGreeting: TIdReply);
var
  LThread : TIdPOP3ServerContext;
  LGreeting : TIdReplyPOP3;
begin
//  AGreeting.Code := OK; {do not localize}
  if Assigned(fCommandAPOP) then
  begin
    LThread := TIdPOP3ServerContext(AContext);
    LGreeting := TIdReplyPOP3.Create(nil);
    try
      LThread.APOP3Challenge := '<'+
              IntToStr(Abs( CurrentProcessId )) +
        '.'+IntToStr(Abs( GetClockValue ))+'@'+ GStack.HostName +'>';
      if AGreeting.Text.Count > 0 then begin
        LGreeting.Text.Add(AGreeting.Text[0] + ' ' + LThread.APOP3Challenge);
      end else begin
        LGreeting.Text.Add('Welcome ' + LThread.APOP3Challenge); {do not localize}
      end;
      LGreeting.Code := OK;
      AContext.Connection.IOHandler.Write(LGreeting.FormattedReply);
    finally
      FreeAndNil(LGreeting);
    end;
  end
  else
  begin
    inherited SendGreeting(AContext, AGreeting);
  end;
end;

end.