idnntpserver.pas

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

      ASender.Reply.NumericCode := 382;
      ASender.SendReply;
      LIO := ASender.Context.Connection.IOHandler as TIdSSLIOHandlerSocketBase;
      LIO.Passthrough := False;
      LCxt := ASender.Context as TIdNNTPContext;
      //reset the connection state as required by http://www.ietf.org/internet-drafts/draft-ietf-nntpext-tls-nntp-00.txt
      LCxt.FUserName := '';
      LCxt.FPassword := '';
      LCxt.FAuthenticated := False;
      LCxt.FModeReader := False;
      ASender.Context.Connection.IOHandler.Write(ReplyUnknownCommand.FormattedReply);
    end;
  end else begin
    ASender.Reply.NumericCode:=500;
  end;
end;

procedure TIdNNTPServer.InitializeCommandHandlers;
begin
  inherited;
  with CommandHandlers.Add do begin
    Command := 'ARTICLE'; {do not localize}
    OnCommand := CommandArticle;
    NormalReply.NumericCode := 500;
    ParseParams := False;
  end;
  with CommandHandlers.Add do begin
    Command := 'AUTHINFO USER'; {do not localize}
    OnCommand := CommandAuthInfoUser;
    NormalReply.NumericCode := 502;
  end;
  with CommandHandlers.Add do begin
    Command := 'AUTHINFO PASS'; {do not localize}
    OnCommand := CommandAuthInfoPassword;
    NormalReply.NumericCode := 502;
  end;
  // TODO: Add AUTHINFO SIMPLE and AUTHINFO GENERIC
  with CommandHandlers.Add do begin
    Command := 'AUTHINFO SIMPLE'; {do not localize}
    NormalReply.NumericCode := 452;
  end;
  with CommandHandlers.Add do begin
    Command := 'AUTHINFO GENERIC';  {do not localize}
    NormalReply.NumericCode := 501;
  end;
  with CommandHandlers.Add do begin
    Command := 'BODY';  {do not localize}
    OnCommand := CommandBody;
    ParseParams := False;
  end;
  with CommandHandlers.Add do begin
    Command := 'DATE';  {do not localize}
    OnCommand := CommandDate;
    ParseParams := False;
  end;
  with CommandHandlers.Add do begin
    Command := 'HEAD';  {do not localize}
    OnCommand := CommandHead;
    ParseParams := False;
  end;
  (*
  3.3.  The HELP command

  3.3.1.  HELP

     HELP

     Provides a short summary of commands that are understood by this
     implementation of the server. The help text will be presented as a
     textual response, terminated by a single period on a line by itself.

     3.3.2.  Responses

     100 help text follows
  *)
  with CommandHandlers.Add do begin
    Command := 'HELP';  {do not localize}
    NormalReply.NumericCode := 100;
    if FHelp.Count = 0 then begin
      Response.Add('No help available.'); {do not localize}
    end else begin
      Response.Assign(FHelp);
    end;
    ParseParams := False;
  end;
  with CommandHandlers.Add do begin
    Command := 'GROUP'; {do not localize}
    OnCommand := CommandGroup;
    NormalReply.NumericCode := 411;
    ParseParams := False;
  end;
  with CommandHandlers.Add do begin
    Command := 'IHAVE'; {do not localize}
    OnCommand := CommandIHave;
    ParseParams := False;
  end;
  with CommandHandlers.Add do begin
    Command := 'LAST';  {do not localize}
    OnCommand := CommandLast;
    ParseParams := False;
  end;
  (*
  2.1.7 LIST OVERVIEW.FMT

     LIST OVERVIEW.FMT

     The overview.fmt file is maintained by some news transport systems to
     contain the order in which header information is stored in the
     overview databases for each news group.  When executed, news article
     header fields are displayed one line at a time in the order in which
     they are stored in the overview database [5] following the 215
     response.  When display is completed, the server will send a period
     on a line by itself.  If the information is not available, the server
     will return the 503 response.

     Please note that if the header has the word "full" (without quotes)
     after the colon, the header's name is prepended to its field in the
     output returned by the server.

     Many newsreaders work better if Xref: is one of the optional fields.

     It is STRONGLY recommended that this command be implemented in any
     server that implements the XOVER command.  See section 2.8 for more
     details about the XOVER command.

  2.1.7.1 Responses

        215 information follows
        503 program error, function not performed
  *)
  // Before LIST
  with CommandHandlers.Add do begin
    Command := 'LIST Overview.fmt'; {do not localize}
    if OverviewFormat.Count > 0 then begin
      NormalReply.NumericCode := 215;
      Response.Assign(OverviewFormat);
    end else begin
      NormalReply.NumericCode := 503;
    end;
    ParseParams := False;
  end;
  // Before LIST
  //TODO: This needs implemented as events to allow return data
  // RFC 2980 - NNTP Extension
  with CommandHandlers.Add do begin
    Command := 'LIST NEWSGROUPS'; {do not localize}
    //ReplyNormal.NumericCode := 503;
    NormalReply.NumericCode := 215;
    Response.Add('.');
    ParseParams := False;
  end;
    {
  From: http://www.ietf.org/internet-drafts/draft-ietf-nntpext-base-17.txt

  }
  with CommandHandlers.Add do begin
    Command := 'LIST EXTENSIONS'; {do not localize}
    OnCommand := CommandListExtensions;
    ParseParams := False;
  end;
  with CommandHandlers.Add do begin
    Command := 'LIST';  {do not localize}
    OnCommand := CommandList;
    NormalReply.NumericCode := 215;
    ParseParams := False;
  end;
  with CommandHandlers.Add do begin
    Command := 'LISTGROUP'; {do not localize}
    OnCommand := CommandListGroup;
    ParseParams := False;
  end;

  with CommandHandlers.Add do begin
    Command := 'MODE READER'; {do not localize}
    OnCommand := CommandModeReader;
    ParseParams := False;
  end;
  with CommandHandlers.Add do begin
    Command := 'NEWGROUPS'; {do not localize}
    OnCommand := CommandNewGroups;
    NormalReply.NumericCode := 231;
  end;
  with CommandHandlers.Add do begin
    Command := 'NEWNEWS'; {do not localize}
    OnCommand := CommandNewNews;
    ParseParams := False;
  end;
  with CommandHandlers.Add do begin
    Command := 'NEXT';  {do not localize}
    OnCommand := CommandNext;
    ParseParams := False;
  end;
  with CommandHandlers.Add do begin
    Command := 'POST';  {do not localize}
    OnCommand := CommandPost;
    ParseParams := False;
  end;
  (*
  3.11.  The QUIT command

  3.11.1.  QUIT

     QUIT

     The server process acknowledges the QUIT command and then closes the
     connection to the client.  This is the preferred method for a client
     to indicate that it has finished all its transactions with the NNTP
     server.

     If a client simply disconnects (or the connection times out, or some
     other fault occurs), the server should gracefully cease its attempts
     to service the client.

  3.11.2.  Responses

     205 closing connection - goodbye!
  *)
  with CommandHandlers.Add do begin
    Command := 'QUIT';  {do not localize}
    Disconnect := True;
    NormalReply.NumericCode := 205;
    ParseParams := False;
  end;
  with CommandHandlers.Add do begin
    Command := 'SLAVE'; {do not localize}
    OnCommand := CommandSlave;
    ParseParams := False;
  end;
  with CommandHandlers.Add do begin
    Command := 'STAT';  {do not localize}
    OnCommand := CommandStat;
    ParseParams := False;
  end;
  with CommandHandlers.Add do begin
    Command := 'XHDR';  {do not localize}
    OnCommand := CommandXHdr;
    ParseParams := True;
    NormalReply.NumericCode := 221;
  end;
  with CommandHandlers.Add do begin
    Command := 'HDR'; {do not localize}
    OnCommand := CommandXHdr;
    ParseParams := True;
    NormalReply.NumericCode := 225;
  end;
  with CommandHandlers.Add do begin
    Command := 'XOVER'; {do not localize}
    OnCommand := CommandXOver;
    NormalReply.NumericCode := 244;
    ParseParams := False;
  end;
  //from http://www.ietf.org/internet-drafts/draft-ietf-nntpext-tls-nntp-00.txt
  with CommandHandlers.Add do begin
    Command := 'OVER';  {do not localize}
    OnCommand := CommandXOver;
    NormalReply.NumericCode := 244;
    ParseParams := False;
  end;
  with CommandHandlers.Add do begin
    Command := 'STARTTLS';  {do not localize}
    OnCommand := CommandSTARTTLS;
  end;


  with ReplyTexts do begin
    // 100s
    Add(100, 'help text follows');                                          {do not localize}
    Add(199, 'debug output');                                               {do not localize}

    // 200s
    Add(200, 'server ready - posting allowed');                             {do not localize}
    Add(201, 'server ready - no posting allowed');                          {do not localize}
    Add(202, 'slave status noted');                                         {do not localize}
    Add(205, 'closing connection - goodbye!');                              {do not localize}
    Add(215, 'list of newsgroups follows');                                 {do not localize}
    Add(221, 'Headers follow');                                             {do not localize}
    Add(224, 'Overview information follows');                               {do not localize}
    Add(225, 'Headers follow');                                             {do not localize}
    Add(231, 'list of new newsgroups follows');                             {do not localize}
    Add(235, 'article transferred ok');                                     {do not localize}
    Add(240, 'article posted ok');                                          {do not localize}
    Add(281,'Authentication accepted');                                     {do not localize}

    // 300s
    Add(335, 'send article to be transferred. End with <CR-LF>.<CR-LF>');   {do not localize}
    Add(340, 'send article to be posted. End with <CR-LF>.<CR-LF>');        {do not localize}
    Add(381, 'More authentication information required');                   {do not localize}
    Add(382,'Continue with TLS negotiation');                               {do not localize}

    // 400s
    Add(400, 'service discontinued');                                       {do not localize}
    Add(403, 'TLS temporarily not available');                              {do not localize}
    Add(411, 'no such news group');                                         {do not localize}
    Add(412, 'no newsgroup has been selected');                             {do not localize}
    Add(420, 'no current article has been selected');                       {do not localize}
    Add(421, 'no next article in this group');                              {do not localize}
    Add(422, 'no previous article in this group');                          {do not localize}
    Add(423, 'no such article number in this group');                       {do not localize}
    Add(430, 'no such article found');                                      {do not localize}
    Add(435, 'article not wanted - do not send it');                        {do not localize}
    Add(436, 'transfer failed - try again later');                          {do not localize}
    Add(437, 'article rejected - do not try again.');                       {do not localize}
    Add(440, 'posting not allowed');                                        {do not localize}
    Add(441, 'posting failed');                                             {do not localize}
    Add(450, 'Authorization required for this command');                    {do not localize}
    Add(452, 'Authorization rejected');                                     {do not localize}
    Add(480, 'Authentication required');                                    {do not localize}
    Add(482, 'Authentication rejected');                                    {do not localize}
    Add(483, 'Strong encryption layer is required');                        {do not localize}

    // 500s
    Add(500, 'command not recognized');                                     {do not localize}
    Add(501, 'command syntax error');                                       {do not localize}
    Add(502, 'access restriction or permission denied');                    {do not localize}
    Add(503, 'program fault - command not performed');                      {do not localize}
    Add(580, 'Security layer already active');                              {do not localize}
  end;
end;

function TIdNNTPServer.AuthOk(ASender: TIdCommand): Boolean;
begin
  Result := (Assigned(FOnAuth)) and (TIdNNTPContext(ASender.Context).Authenticated = False);
  if Result then begin
    ASender.Reply.NumericCode := 450;
  end;
end;

function TIdNNTPServer.RawNavigate(AThread: TIdNNTPContext;
  AEvent: TIdNNTPOnMovePointer): String;
var LMsgNo : Integer;
begin
  Result := '';
  LMsgNo := AThread.CurrentArticle;
  if (AThread.CurrentArticle > 0) then
  begin
    AEvent(AThread,LMsgNo,Result);
    if (LMsgNo > 0) and (LMsgNo <> AThread.CurrentArticle) and (Result <> '') then
    begin
      AThread.FCurrentArticle := LMsgNo;
    end;
  end;
end;

procedure TIdNNTPServer.SetHelp(AValue: TIdStrings);
begin
  FHelp.Assign(AValue);
end;

{ TIdNNTPContext }

constructor TIdNNTPContext.Create(
  AConnection: TIdTCPConnection;
  AYarn: TIdYarn;
  AList: TThreadList = nil
  );
begin
  inherited Create(AConnection, AYarn, AList);
  FCurrentArticle := 0;
end;

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

procedure TIdNNTPServer.SetOverviewFormat(AValue: TIdStrings);
begin
  FOverviewFormat.Assig