idnntpserver.pas

Indy控件的使用源代码

  if AuthRequired(ASender) then begin
    Exit;
  end;
  if (ASender.Params.Count > 3) 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 > 4 then
    begin
      if (UpperCase(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;
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
      ASender.Reply.NumericCode := 412
    else
    begin
      LMsgID := RawNavigate(LThread,OnNextArticle);
      if LMsgID<>'' then
      begin
        LMsgNo := LThread.CurrentArticle;
        ASender.Reply.SetReply(223, IntToStr(LMsgNo) + ' ' + LMsgID + ' article retrieved - request text separately')
      end
      else
        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: Boolean;
  LErrorText: string;
  LPostOk: Boolean;
  LReply: TIdRFCReply;
begin
  if AuthRequired(ASender) then begin
    Exit;
  end;
  LCanPost := Assigned(OnPost);
  LReply := TIdRFCReply.Create(nil);
  LReply.NumericCode := iif(LCanPost, 340, 440);
  ReplyTexts.UpdateText(LReply);
  ASender.Thread.Connection.WriteRFCReply(LReply);
  if LCanPost then begin
    LPostOk := False;
    LErrorText := '';
    OnPost(TIdNNTPThread(ASender.Thread), LPostOk, LErrorText);
    ASender.Reply.SetReply(iif(LPostOk, 240, 441), LErrorText);
  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;
  LThread: TIdNNTPThread;
begin
  if not AuthRequired (ASender) then
  begin
    if LookupMessage (ASender, LMsgNo, LMsgID) then
    begin
      LThread := TidNNTPThread (ASender.Thread);
      ASender.Reply.SetReply (223, IntToStr(LMsgNo) + ' ' + LMsgID + ' article retrieved - request text separately');
      ASender.SendReply;
      if Assigned (OnStatMsgNo) then
        OnStatMsgNo(LThread, LMsgNo, LMsgID)
    end;
  end;
end;

procedure TIdNNTPServer.CommandXHdr(ASender: TIdCommand);
var
  i: Integer;
  s: String;
  LFirstMsg: Integer;
  LLastMsg : Integer;
begin
  if not Assigned (OnXHdr) then
  begin
    ASender.Reply.NumericCode := 500;
    exit
  end;

  if not AuthRequired(ASender) then begin
    if Length(TIdNNTPThread(ASender.Thread).CurrentGroup) = 0 then begin
      ASender.Reply.NumericCode := 412;
    end else begin
      if ASender.Params.Count > 0 then begin
        s := '';
        for i := 1 to ASender.Params.Count-1 do begin
          s := s + ASender.Params[i] + ' ';
        end;
        s := Trim(s);
        LFirstMsg := StrToIntDef(Trim(Fetch(s, '-')), 0);
        if LFirstMsg = 0 then begin
          LFirstMsg := TIdNNTPThread(ASender.Thread).CurrentArticle;
          LLastMsg := LFirstMsg;
        end else begin
          if Pos('-', ASender.UnparsedParams) > 0 then begin
            LLastMsg := StrToIntDef(Trim(s), 0);
          end else begin
            LLastMsg := LFirstMsg;
          end;
        end;
        if LFirstMsg = 0 then begin
          ASender.Reply.NumericCode := 420;
        end else begin
          ASender.Reply.NumericCode := 221;
          ASender.SendReply;
          // No need for DoOnXhdr - only this proc can call it and it already checks for nil
          FOnXhdr(TIdNNTPThread(ASender.Thread), ASender.Params[0], LFirstMsg, LLastMsg);
          ASender.Thread.Connection.WriteLn('.');
        end;
      end;
    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
  s: string;
  LFirstMsg: Integer;
  LLastMsg: Integer;
begin
  if not Assigned (OnXOver) then
  begin
    ASender.Reply.NumericCode := 500;
    exit
  end;

  if AuthRequired(ASender) then begin
    Exit;
  end;
  if Length(TIdNNTPThread(ASender.Thread).CurrentGroup) = 0 then begin
    ASender.Reply.NumericCode := 412;
  end else begin
    s := ASender.UnparsedParams;
    LFirstMsg := StrToIntDef(Trim(Fetch(s, '-')), -1);
    if LFirstMsg = -1 then begin
      LFirstMsg := TIdNNTPThread(ASender.Thread).CurrentArticle;
      LLastMsg := LFirstMsg;
    end else begin
      LLastMsg := StrToIntDef(Trim(s), -1);
    end;
    if LFirstMsg = -1 then begin
      ASender.Reply.NumericCode := 420;
    end else begin
      ASender.Reply.NumericCode := 224;
      ASender.SendReply;
      // No need for DoOnXover - only this proc can call it and it already checks for nil
      OnXOver(TIdNNTPThread(ASender.Thread), LFirstMsg, LLastMsg);
      ASender.Thread.Connection.WriteLn('.');
    end;
  end;
end;

constructor TIdNNTPServer.Create(AOwner: TComponent);
begin
  inherited;
  FHelp := TStringList.Create;

  FOverviewFormat := TStringList.Create;
  with FOverviewFormat do begin
    Add('Subject:');
    Add('From:');
    Add('Date:');
    Add('Message-ID:');
    Add('References:');
    Add('Bytes:');
    Add('Lines:');
  end;

  ThreadClass := TIdNNTPThread;
  DefaultPort := IdPORT_NNTP;
  (*
  In general, 1xx codes may be ignored or displayed as desired;  code
  200 or 201 is sent upon initial connection to the NNTP server
  depending upon posting permission;  *)
  // TODO: Account for 201 as well. Right now the user can override this if they wish
  Greeting.NumericCode := 200;
  //
  ReplyExceptionCode := 503;
  ReplyUnknownCommand.NumericCode := 500;
  ReplyUnknownCommand.Text.Text := RSNNTPServerNotRecognized;
end;

destructor TIdNNTPServer.Destroy;
begin
  FreeAndNil(FOverviewFormat);
  FreeAndNil(FHelp);
  inherited;
end;

procedure TIdNNTPServer.DoListGroups(AThread: TIdNNTPThread);
begin
  if Assigned(OnListGroups) then
    OnListGroups(AThread)
end;

procedure TIdNNTPServer.DoSelectGroup(AThread: TIdNNTPThread; const AGroup: string; var VMsgCount,
  VMsgFirst, VMsgLast: Integer; var VGroupExists: Boolean);
begin
  VMsgCount := 0;
  VMsgFirst := 0;
  VMsgLast := 0;
  VGroupExists := False;
  if Assigned(OnSelectGroup) then begin
    OnSelectGroup(TIdNNTPThread(AThread), AGroup, VMsgCount, VMsgFirst, VMsgLast, VGroupExists);
  end;
end;

procedure TIdNNTPServer.InitializeCommandHandlers;
begin
  inherited;
  with CommandHandlers.Add do begin
    Command := 'ARTICLE';
    OnCommand := CommandArticle;
    ReplyNormal.NumericCode := 500;
    ParseParams := False;
  end;
  with CommandHandlers.Add do begin
    Command := 'AUTHINFO USER';
    OnCommand := CommandAuthInfoUser;
    ReplyNormal.NumericCode := 502;
  end;
  with CommandHandlers.Add do begin
    Command := 'AUTHINFO PASS';
    OnCommand := CommandAuthInfoPassword;
    ReplyNormal.NumericCode := 502;
  end;
  // TODO: Add AUTHINFO SIMPLE and AUTHINFO GENERIC
  with CommandHandlers.Add do begin
    Command := 'AUTHINFO SIMPLE';
    ReplyNormal.NumericCode := 452;
  end;
  with CommandHandlers.Add do begin
    Command := 'AUTHINFO GENERIC';
    ReplyNormal.NumericCode := 501;
  end;
  with CommandHandlers.Add do begin
    Command := 'BODY';
    OnCommand := CommandBody;
    ParseParams := False;
  end;
  with CommandHandlers.Add do begin
    Command := 'DATE';
    OnCommand := CommandDate;
    ParseParams := False;
  end;
  with CommandHandlers.Add do begin
    Command := 'HEAD';
    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.