idnntpserver.pas

delphi indy9.0.18组件包

   The optional parameter "distributions" is a list of distribution
   groups, enclosed in angle brackets.  If specified, the distribution
   portion of a new newsgroup (e.g, 'net' in 'net.wombat') will be
   examined for a match with the distribution categories listed, and
   only those new newsgroups which match will be listed.  If more than
   one distribution group is to be listed, they must be separated by
   commas within the angle brackets.

   Please note that an empty list (i.e., the text body returned by this
   command consists only of the terminating period) is a possible valid
   response, and indicates that there are currently no new newsgroups.

3.7.2.  Responses

   231 list of new newsgroups follows
*)
procedure TIdNNTPServer.CommandNewGroups(ASender: TIdCommand);
var LDate : TDateTime;
    LDist : String;
begin
  if not Assigned(OnListNewGroups) then
  begin
    ASender.Reply.NumericCode := 500;
    Exit;
  end;
  if not AuthRequired(ASender) then begin
    if (ASender.Params.Count > 1) then
    begin
      LDist := '';
      LDate := NNTPDateTimeToDateTime( ASender.Params[0] );
      LDate := LDate + NNTPTimeToTime( ASender.Params[1] );
      if (ASender.Params.Count > 2) then
      begin
        if AnsiSameText(ASender.Params[2], 'GMT') then {Do not translate}
        begin
          LDate := LDate + OffSetFromUTC;
          if (ASender.Params.Count > 3) then
          begin
            LDist := ASender.Params[3];
          end;
        end
        else
        begin
          LDist := ASender.Params[2];
        end;
      end;
      ASender.SendReply;
      FOnListNewGroups(TIdNNTPThread(ASender.Thread), LDate, LDist);
      ASender.Thread.Connection.WriteLn('.');
    end else begin;
      ASender.Reply.NumericCode := 501;
    end;
  end;
end;

procedure TIdNNTPServer.CommandNewNews(ASender: TIdCommand);
var LDate : TDateTime;
    LDist : String;
begin
  if not Assigned(OnNewNews) then
  begin
    ASender.Reply.NumericCode := 500;
    Exit;
  end;
  if not AuthRequired(ASender) then begin
    if (ASender.Params.Count > 2) then
    begin
      //0 - newsgroup
      //1 - date
      //2 - time
      //3 - GMT or distributions
      //4 - distributions if 3 was GMT
      LDist := '';
      LDate := NNTPDateTimeToDateTime( ASender.Params[1] );
      LDate := LDate + NNTPTimeToTime( ASender.Params[2] );
      if (ASender.Params.Count > 3) then
      begin
        if AnsiSameText(ASender.Params[3], 'GMT') then {Do not translate}
        begin
          LDate := LDate + OffSetFromUTC;
          if (ASender.Params.Count > 4) then
          begin
            LDist := ASender.Params[4];
          end;
        end
        else
        begin
          LDist := ASender.Params[3];
        end;
      end;
      ASender.SendReply;
      FOnNewNews( TIdNNTPThread(ASender.Thread), ASender.Params[0], LDate, LDist );
      ASender.Thread.Connection.WriteLn('.');
    end else begin;
      ASender.Reply.NumericCode := 501;
    end;
  end;
end;

procedure TIdNNTPServer.CommandNext(ASender: TIdCommand);
var
  LMsgNo: Integer;
  LThread: TIdNNTPThread;
  LMsgID : String;
begin
  if not Assigned(OnNextArticle) then
  begin
    ASender.Reply.NumericCode := 500;
    Exit;
  end;
  if not AuthRequired(ASender) then
  begin
    LThread := TIdNNTPThread(ASender.Thread);
    if Length(LThread.CurrentGroup) = 0 then begin
      ASender.Reply.NumericCode := 412;
      Exit;
    end;
    LMsgID := RawNavigate(LThread, OnNextArticle);
    if Length(LMsgID) <> 0 then begin
      LMsgNo := LThread.CurrentArticle;
      ASender.Reply.SetReply(223, IntToStr(LMsgNo) + ' ' + LMsgID + ' article retrieved - request text separately')
    end else begin
      ASender.Reply.NumericCode := 421;
    end;
  end
end;

(*
3.10.  The POST command

3.10.1.  POST

   POST

   If posting is allowed, response code 340 is returned to indicate that
   the article to be posted should be sent. Response code 440 indicates
   that posting is prohibited for some installation-dependent reason.

   If posting is permitted, the article should be presented in the
   format specified by RFC850, and should include all required header
   lines. After the article's header and body have been completely sent
   by the client to the server, a further response code will be returned
   to indicate success or failure of the posting attempt.

   The text forming the header and body of the message to be posted
   should be sent by the client using the conventions for text received
   from the news server:  A single period (".") on a line indicates the
   end of the text, with lines starting with a period in the original
   text having that period doubled during transmission.

   No attempt shall be made by the server to filter characters, fold or
   limit lines, or otherwise process incoming text.  It is our intent
   that the server just pass the incoming message to be posted to the
   server installation's news posting software, which is separate from
   this specification.  See RFC850 for more details.

   Since most installations will want the client news program to allow
   the user to prepare his message using some sort of text editor, and
   transmit it to the server for posting only after it is composed, the
   client program should take note of the herald message that greeted it
   when the connection was first established. This message indicates
   whether postings from that client are permitted or not, and can be
   used to caution the user that his access is read-only if that is the
   case. This will prevent the user from wasting a good deal of time
   composing a message only to find posting of the message was denied.
   The method and determination of which clients and hosts may post is
   installation dependent and is not covered by this specification.

3.10.2.  Responses

   240 article posted ok
   340 send article to be posted. End with <CR-LF>.<CR-LF>
   440 posting not allowed
   441 posting failed

   (for reference, one of the following codes will be sent upon initial
   connection; the client program should determine whether posting is
   generally permitted from these:) 200 server ready - posting allowed
   201 server ready - no posting allowed
*)
procedure TIdNNTPServer.CommandPost(ASender: TIdCommand);
var
  LCanPost, LPostOk: Boolean;
  LErrorText: string;
  LReply: TIdRFCReply;
begin
  if not AuthRequired(ASender) then begin
    LCanPost := Assigned(OnPost);
    LReply := TIdRFCReply.Create(nil);
    try
      LReply.NumericCode := iif(LCanPost, 340, 440);
      ReplyTexts.UpdateText(LReply);
      ASender.Thread.Connection.WriteRFCReply(LReply);
    finally
      FreeAndNil(LReply);
    end;
    if LCanPost then begin
      LPostOk := False;
      LErrorText := '';
      OnPost(TIdNNTPThread(ASender.Thread), LPostOk, LErrorText);
      ASender.Reply.SetReply(iif(LPostOk, 240, 441), LErrorText);
    end;
  end;
end;

procedure TIdNNTPServer.CommandSlave(ASender: TIdCommand);
begin
  TIdNNTPThread(ASender.Thread).FModeReader := False;
  ASender.Reply.NumericCode := 220;
end;

procedure TIdNNTPServer.CommandStat(ASender: TIdCommand);
var
  LMsgID: string;
  LMsgNo: Integer;
begin
  if not AuthRequired(ASender) then
  begin
    if LookupMessage(ASender, LMsgNo, LMsgID) then
    begin
      ASender.Reply.SetReply(223, IntToStr(LMsgNo) + ' ' + LMsgID + ' article retrieved - request text separately');
      ASender.SendReply;
      if Assigned(OnStatMsgNo) then begin
        OnStatMsgNo(TIdNNTPThread(ASender.Thread), LMsgNo, LMsgID);
      end;
    end;
  end;
end;

procedure TIdNNTPServer.CommandXHdr(ASender: TIdCommand);
var
  s: String;
  LFirstMsg: Integer;
  LLastMsg : Integer;
  LMsgID: String;
  LThread: TIdNNTPThread;
begin
  if not Assigned(OnXHdr) then
  begin
    ASender.Reply.NumericCode := 500;
    Exit;
  end;
  if not AuthRequired(ASender) then begin
    LThread := TIdNNTPThread(ASender.Thread);
    if (ASender.Params.Count > 0) then begin
      if (ASender.Params.Count > 1) then begin
        s := ASender.Params[1];
      end;
      if LookupMessageRangeOrID(ASender, s, LFirstMsg, LLastMsg, LMsgID) then begin
        ASender.Reply.SetReply(221, 'Header follows');  {do not localize}
        ASender.SendReply;
        FOnXhdr(LThread, ASender.Params[0], LFirstMsg, LLastMsg, LMsgID);
        LThread.Connection.WriteLn('.');
      end;
    end
    else
    begin
      ASender.Reply.NumericCode := 501;
    end;
  end;
end;

(*
2.8 XOVER

   XOVER [range]

   The XOVER command returns information from the overview database for
   the article(s) specified.  This command was originally suggested as
   part of the OVERVIEW work described in "The Design of a Common
   Newsgroup Overview Database for Newsreaders" by Geoff Collyer.  This
   document is distributed in the Cnews distribution.  The optional
   range argument may be any of the following:

               an article number
               an article number followed by a dash to indicate
                  all following
               an article number followed by a dash followed by
                  another article number

   If no argument is specified, then information from the current
   article is displayed.  Successful responses start with a 224 response
   followed by the overview information for all matched messages.  Once
   the output is complete, a period is sent on a line by itself.  If no
   argument is specified, the information for the current article is
   returned.  A news group must have been selected earlier, else a 412
   error response is returned.  If no articles are in the range
   specified, a 420 error response is returned by the server.  A 502
   response will be returned if the client only has permission to
   transfer articles.

   Each line of output will be formatted with the article number,
   followed by each of the headers in the overview database or the
   article itself (when the data is not available in the overview
   database) for that article separated by a tab character.  The
   sequence of fields must be in this order: subject, author, date,
   message-id, references, byte count, and line count.  Other optional
   fields may follow line count.  Other optional fields may follow line
   count.  These fields are specified by examining the response to the
   LIST OVERVIEW.FMT command.  Where no data exists, a null field must
   be provided (i.e. the output will have two tab characters adjacent to
   each other).  Servers should not output fields for articles that have
   been removed since the XOVER database was created.

   The LIST OVERVIEW.FMT command should be implemented if XOVER is
   implemented.  A client can use LIST OVERVIEW.FMT to determine what
   optional fields  and in which order all fields will be supplied by
   the XOVER command.  See Section 2.1.7 for more details about the LIST
   OVERVIEW.FMT command.

   Note that any tab and end-of-line characters in any header data that
   is returned will be converted to a space character.

2.8.1 Responses

      224 Overview information follows
      412 No news group current selected
      420 No article(s) selected
      502 no permission
*)
procedure TIdNNTPServer.CommandXOver(ASender: TIdCommand);
var
  LFirstMsg: Integer;
  LLastMsg: Integer;
begin
  if not Assigned(OnXOver) then
  begin
    ASender.Reply.NumericCode := 500;
    Exit;
  end;
  if not AuthRequired(ASender) then begin
    if LookupMessageRange(ASender, ASender.UnparsedParams, LFirstMsg, LLastMsg) then begin
      ASender.Reply.NumericCode := 224;
      ASender.SendReply;
      OnXOver(TIdNNTPThread(ASender.Thread), LFirstMsg, LLastMsg);
      ASender.Thread.Connection.WriteLn('.');
    end;
  end;
end;

(*
2.11 The XROVER command

   XROVER [range]

   The XROVER command returns reference information from the overview
   database for the article(s) specified.  This command first appeared
   in the Unix reference implementation.  The optional range argument
   may be any of the following:

               an article number
               an article number followed by a dash to indicate
                    all following
               an article number followed by a dash followed