idnntpserver.pas

Indy控件的使用源代码

{ $HDR$}
{**********************************************************************}
{ Unit archived using Team Coherence                                   }
{ Team Coherence is Copyright 2002 by Quality Software Components      }
{                                                                      }
{ For further information / comments, visit our WEB site at            }
{ http://www.TeamCoherence.com                                         }
{**********************************************************************}
{}
{ $Log:  10273: IdNNTPServer.pas 
{
{   Rev 1.2    3/17/2003 08:54:04 AM  JPMugaas
{ Missing reply texts.
}
{
{   Rev 1.1    2002.11.15 10:44:50 PM  czhower
{ Fixed some issues with authentication.
}
{
{   Rev 1.0    2002.11.12 10:47:24 PM  czhower
}
unit IdNNTPServer;

interface
   
{
Sept 2002
  - Colin Wilson - fixes.

  - GROUP sets the current article pointer to the first message in the group.
  - LAST & NEXT now return '412 no newsgroup has been selected' if no newsgroup
    has been selected
  - LAST & NEXT now return the correct article number as well as the correct
    message ID
  - NEXT now goes to the next article instead of the previous one
  - LAST now returns '422 no previous article in this group' if there's no
    previous article
  - NEXT now returns '421 no next article in this group' is there's no next
    article.

  - ARTICLE, HEAD, BODY & STAT now use the same 'LookupMessage' code.

    - If the current group isn't set '412 no newsgroup has been selected' is
      returned
    - If there is no parameter the current article pointer is used.  If this has
      not been set, '420 no current article has been selected' is returned
    - If the parameter is numeric, the ID is looked up using OnCheckMsgNo.  If
      this fails, the '423 no such article number in this group' is returned
    - If the parameter starts with '<' the article number is looked up using the
      (new) OnCheckMsgId event.  If this fails, or the parameter didn't start
      with '<' '430 no such article found' is returned.

    - HEAD, BODY & STAT now return the appropriate success codes (221, 222, 223)
      instead of the generic '220'
    - STAT has been brought into line with ARTICLE, HEAD & BODY - the OnStatMsgNo
      callback is now called once the 'success' code has been sent.  I've left the
      parameters as 'var' even though they should be 'const' for compatibilty with
      previous versions.

    - New 'OnAuthRequired' event allows the user to select whether a particular
      command/parameter combination needs authentication.
    - Authentication accepted now returns '281 authentication accepted' rather
      than just a bald '281'
    - Password required now returns '381 more authentication information required'
      rather than just '381'


July 2002
  -Kudzu - Fixes to Authorization and other parts
Oct/Nov 2001
  -Kudzu - Rebuild from scratch for proper use of command handlers and around new
  architecture.
2001-Jul-31 Jim Gunkel
  Reorganized for command handlers
2001-Jun-28 Pete Mee
  Begun transformation to TIdCommandHandler
2000-Apr-22 Mark L. Holmes
  Ported to Indy
2000-Mar-27
  Final Version
2000-Jan-13 MTL
  Moved to new Palette Scheme (Winshoes Servers)
Original Author: Ozz Nixon (Winshoes 7)
}

uses
  Classes,
  IdAssignedNumbers, IdGlobal,
  IdTCPServer;

(*
 For more information on NNTP visit http://www.faqs.org/rfcs/

 RFC 977 - A Proposed Standard for the Stream-Based Transmission of News
 RFC 2980 - Common NNTP Extensions
 RFC 1036 - Standard for Interchange of USENET Messages
 RFC 822 - Standard for the Format of ARPA Internet Text
*)

(*
Responses

   100 help text follows
   199 debug output

   200 server ready - posting allowed
   201 server ready - no posting allowed
   202 slave status noted
   205 closing connection - goodbye!
   211 n f l s group selected
   215 list of newsgroups follows
   220 n <a> article retrieved - head and body follow 221 n <a> article
   retrieved - head follows
   222 n <a> article retrieved - body follows
   223 n <a> article retrieved - request text separately 230 list of new
   articles by message-id follows
   231 list of new newsgroups follows
   235 article transferred ok
   240 article posted ok
   281 Authentication accepted



   335 send article to be transferred.  End with <CR-LF>.<CR-LF>
   340 send article to be posted. End with <CR-LF>.<CR-LF>
   381 More authentication information required
   400 service discontinued
   411 no such news group
   412 no newsgroup has been selected
   420 no current article has been selected
   421 no next article in this group
   422 no previous article in this group
   423 no such article number in this group
   430 no such article found
   435 article not wanted - do not send it
   436 transfer failed - try again later
   437 article rejected - do not try again.
   440 posting not allowed
   441 posting failed
   480 Authentication required
   482 Authentication rejected
   500 command not recognized
   501 command syntax error
   502 access restriction or permission denied
   503 program fault - command not performed
*)

type
  TIdNNTPThread = class(TIdPeerThread)
  protected
    FCurrentArticle: Integer;
    FCurrentGroup: string;
    FUserName: string;
    FPassword: string;
    FAuthenticated : Boolean;
    FModeReader: Boolean;
  public
    constructor Create(ACreateSuspended: Boolean = True); override;
    //
    property CurrentArticle: Integer read FCurrentArticle;
    property CurrentGroup: string read FCurrentGroup;
    property ModeReader: Boolean read FModeReader;
    property UserName: string read FUserName;
    property Password: string read FPassword;
    property Authenticated: Boolean read FAuthenticated;
  end;

  TIdNNTPOnAuth = procedure(AThread: TIdNNTPThread; var VAccept: Boolean) of object;
  TIdNNTPOnNewGroupsList = procedure ( AThread: TIdNNTPThread; const ADateStamp : TDateTime; const ADistributions : String) of object;
  TIdNNTPOnNewNews = procedure ( AThread: TIdNNTPThread; const Newsgroups : String; const ADateStamp : TDateTime; const ADistributions : String) of object;
  TIdNNTPOnIHaveCheck = procedure(AThread: TIdNNTPThread; const AMsgID : String; VAccept : Boolean) of object;
  TIdNNTPOnArticleByNo = procedure(AThread: TIdNNTPThread; const AMsgNo: Integer) of object;
  TIdNNTPOnArticleByID = procedure(AThread: TIdNNTPThread; const AMsgID: string) of object;
  TIdNNTPOnCheckMsgNo = procedure(AThread: TIdNNTPThread; const AMsgNo: Integer;var VMsgID: string) of object;
  TIdNNTPOnCheckMsgID = procedure(AThread: TIdNNTPThread; const AMsgId : string; var VMsgNo : Integer) of object;
  //this has to be a separate event type in case a NNTP client selects a message
  //by Message ID instead of Index number.  If that happens, the user has to
  //to return the index number.  NNTP Clients setting STAT by Message ID is not
  //a good idea but is valid.
  TIdNNTPOnMovePointer = procedure(AThread: TIdNNTPThread; var AMsgNo: Integer;
   var VMsgID: string) of object;
  TIdNNTPOnPost = procedure(AThread: TIdNNTPThread; var VPostOk: Boolean;
   var VErrorText: string) of object;
  TIdNNTPOnSelectGroup = procedure(AThread: TIdNNTPThread; const AGroup: string;
   var VMsgCount: Integer; var VMsgFirst: Integer; var VMsgLast: Integer;
   var VGroupExists: Boolean) of object;
  TIdNNTPOnCheckListGroup = procedure(AThread: TIdNNTPThread; const AGroup: string;
   var VCanJoin : Boolean; var VFirstArticle : Integer) of object;
  TIdNNTPOnXOver = procedure(AThread: TIdNNTPThread; const AMsgFirst: Integer;
   const AMsgLast: Integer) of object;
  TIdNNTPOnXHdr = procedure(AThread: TIdNNTPThread; const AHeaderName : String; const AMsgFirst: Integer;
   const AMsgLast: Integer) of object;
  TIdNNTPOnAuthRequired = procedure(AThread: TIdNNTPThread; const ACommand, AParams : string; var VRequired: Boolean) of object;

  TIdNNTPServer = class(TIdTCPServer)
  private
  protected
    FHelp: TStrings;
    FOverviewFormat: TStrings;
    FOnArticleByNo: TIdNNTPOnArticleByNo;
    FOnBodyByNo: TIdNNTPOnArticleByNo;
    FOnHeadByNo: TIdNNTPOnArticleByNo;
    FOnCheckMsgNo: TIdNNTPOnCheckMsgNo;
    FOnCheckMsgId: TidNNTPOnCheckMsgId;
    FOnStatMsgNo : TIdNNTPOnMovePointer;
    FOnNextArticle : TIdNNTPOnMovePointer;
    FOnPrevArticle : TIdNNTPOnMovePointer;
    //LISTGROUP events - Gravity uses these
    FOnCheckListGroup : TIdNNTPOnCheckListGroup;
    FOnListGroup : TIdServerThreadEvent;

    FOnListGroups: TIdServerThreadEvent;
    FOnListNewGroups : TIdNNTPOnNewGroupsList;
    FOnPost: TIdNNTPOnPost;
    FOnSelectGroup: TIdNNTPOnSelectGroup;
    FOnXOver: TIdNNTPOnXOver;
    FOnXHdr: TIdNNTPOnXHdr;
    FOnNewNews : TIdNNTPOnNewNews;
    FOnIHaveCheck : TIdNNTPOnIHaveCheck;
    FOnIHavePost: TIdNNTPOnPost;
    FOnAuth: TIdNNTPOnAuth;
    FOnAuthRequired: TIdNNTPOnAuthRequired;

    function AuthRequired(ASender: TIdCommand): Boolean;
    //return MsgID - AThread.CurrentArticlePointer already set
    function RawNavigate(AThread: TIdNNTPThread; AEvent : TIdNNTPOnMovePointer) : String;
    procedure CommandArticle(ASender: TIdCommand);
    procedure CommandAuthInfoUser(ASender: TIdCommand);
    procedure CommandAuthInfoPassword(ASender: TIdCommand);
    procedure CommandBody(ASender: TIdCommand);
    procedure CommandDate(ASender: TIdCommand);
    procedure CommandHead(ASender: TIdCommand);
    procedure CommandGroup(ASender: TIdCommand);
    procedure CommandIHave(ASender: TIdCommand);
    procedure CommandLast(ASender: TIdCommand);
    procedure CommandList(ASender: TIdCommand);
    procedure CommandListGroup(ASender: TIdCommand);
    procedure CommandModeReader(ASender: TIdCommand);
    procedure CommandNewGroups(ASender: TIdCommand);
    procedure CommandNewNews(ASender: TIdCommand);
    procedure CommandNext(ASender: TIdCommand);
    procedure CommandPost(ASender: TIdCommand);
    procedure CommandSlave(ASender: TIdCommand);
    procedure CommandStat(ASender: TIdCommand);
    procedure CommandXHdr(ASender: TIdCommand);
    procedure CommandXOver(ASender: TIdCommand);
    procedure DoListGroups(AThread: TIdNNTPThread);
    procedure DoSelectGroup(AThread: TIdNNTPThread; const AGroup: string; var VMsgCount: Integer;
     var VMsgFirst: Integer; var VMsgLast: Integer; var VGroupExists: Boolean);
    procedure InitializeCommandHandlers; override;
    procedure SetHelp(AValue: TStrings);
    procedure SetOverviewFormat(AValue: TStrings);
    function LookupMessage (ASender : TidCommand; var VNo : Integer; var VId : string) : boolean;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    class function NNTPTimeToTime(const ATimeStamp : String): TDateTime;
    class function NNTPDateTimeToDateTime(const ATimeStamp: string): TDateTime;
  published
    property DefaultPort default IdPORT_NNTP;
    property Help: TStrings read FHelp write SetHelp;
    property OnArticleByNo: TIdNNTPOnArticleByNo read FOnArticleByNo write FOnArticleByNo;
    property OnAuth: TIdNNTPOnAuth read FOnAuth write FOnAuth;
    property OnAuthRequired : TIdNNTPOnAuthRequired read FOnAuthRequired write FOnAuthRequired;
    property OnBodyByNo: TIdNNTPOnArticleByNo read FOnBodyByNo write FOnBodyByNo;
    property OnHeadByNo: TIdNNTPOnArticleByNo read FOnHeadByNo write FOnHeadByNo;
    property OnCheckMsgNo: TIdNNTPOnCheckMsgNo read FOnCheckMsgNo write FOnCheckMsgNo;
    property OnCheckMsgID: TidNNTPOnCheckMsgId read FOnCheckMsgId write FOnCheckMsgId;
    property OnStatMsgNo : TIdNNTPOnMovePointer read FOnStatMsgNo write FOnStatMsgNo;
    //You are responsible for writing event handlers for these instead of us incrementing
    //and decrimenting the pointer.  This design permits you to implement article expirity,
    //cancels, and supercedes
    property OnNextArticle : TIdNNTPOnMovePointer read FOnNextArticle write FOnNextArticle;
    property OnPrevArticle : TIdNNTPOnMovePointer read FOnPrevArticle write FOnPrevArticle;
    property OnCheckListGroup : TIdNNTPOnCheckListGroup read FOnCheckListGroup write FOnCheckListGroup;
    property OnListGroups: TIdServerThreadEvent read FOnListGroups write FOnListGroups;
    property OnListGroup : TIdServerThreadEvent read FOnListGroup write FOnListGroup;
    property OnListNewGroups : TIdNNTPOnNewGroupsList read FOnListNewGroups write FOnListNewGroups;
    property OnSelectGroup: TIdNNTPOnSelectGroup read FOnSelectGroup write FOnSelectGroup;
    property OnPost: TIdNNTPOnPost read FOnPost write FOnPost;
    property OnXOver: TIdNNTPOnXOver read FOnXOver write FOnXOver;
    property OverviewFormat: TStrings read FOverviewFormat write SetOverviewFormat;
    property OnXHdr: TIdNNTPOnXHdr read FOnXHdr write FOnXHdr;
    property OnNewNews : TIdNNTPOnNewNews read FOnNewNews write FOnNewNews;
    property OnIHaveCheck : TIdNNTPOnIHaveCheck read FOnIHaveCheck write FOnIHaveCheck;
    property OnIHavePost: TIdNNTPOnPost read FOnIHavePost write FOnIHavePost;
  end;

implementation

uses
  IdResourceStrings, IdRFCReply,
  SysUtils;

Const
  AuthTypes: array [1..2] of string = ('USER', 'PASS'); {Do not localize}

class function TIdNNTPServer.NNTPTimeToTime(const ATimeStamp : String): TDateTime;
var
  LHr, LMn, LSec : Word;
  LTimeStr : String;
begin
  LTimeStr := ATimeStamp;
  if LTimeStr <> '' then
  begin
    LHr := StrToIntDef(Copy(LTimeStr,1,2),1);
    Delete(LTimeStr,1,2);
    LMn := StrToIntDef(Copy(LTimeStr,1,2),1);
    Delete(LTimeStr,1,2);
    LSec := StrToIntDef(Copy(LTimeStr,1,2),1);
    Delete(LTimeStr,1,2);
    Result := EncodeTime(LHr, LMn, LSec,0);
    LTimeStr := Trim(LTimeStr);
    if UpperCase(LTimeStr)='GMT' then
    begin
      // Apply local offset
      Result := Result + OffSetFromUTC;
    end;
  end else begin
    Result := 0;
  end;
end;

class function TIdNNTPServer.NNTPDateTimeToDateTime(const ATimeStamp : String): TDateTime;
var
  LYr, LMo, LDay : Word;
    LTimeStr : String;
    LDateStr : String;
begin
  Result := 0;
  if ATimeStamp <> '' then begin
    LTimeStr := ATimeStamp;
    LDateStr := Fetch(LTimeStr);
    if (Length(LDateStr) > 6) then begin
      //four digit year, good idea - IMAO
      LYr := StrToIntDef(Copy(LDateStr,1,4),1969);
      Delete(LDateStr,1,4);
    end else begin
      LYr := StrToIntDef(Copy(LDateStr,1,2),69);
      Delete(LDateStr,1,2);
      LYr := LYr + 2000;
    end;
    LMo := StrToIntDef(Copy(LDateStr,1,2),1);
    Delete(LDateStr,1,2);
    LDay := StrToIntDef(Copy(LDateStr,1,2),1);
    Delete(LDateStr,1,2);
    Result := EncodeDate(LYr, LMo, LDay) + NNTPTimeToTime(LTimeStr);
  end;
end;

(*
3.1.  The ARTICLE, BODY, HEAD, and STAT commands

   There are two forms to the ARTICLE command (and the related BODY,
   HEAD, and STAT commands), each using a different method of specifying
   which article is to be retrieved.  When the ARTICLE command is
   followed by a message-id in angle brackets ("<" and ">"), the first
   form of the command is used; when a numeric parameter or no parameter
   is supplied, the second form is invoked.

   The text of the article is returned as a textual response, as
   described earlier in this document.

   The HEAD and BODY commands are identical to the ARTICLE command
   except that they respectively return only the header lines or text
   body of the article.

   The STAT command is similar to the ARTICLE command except that no
   text is returned.  When selecting by message number within a group,
   the STAT command serves to set the current article pointer without
   sending text. The returned acknowledgement response will contain the
   message-id, which may be of some value.  Using the STAT command to
   select by message-id is valid but of questionable value, since a
   selection by message-id does NOT alter the "current article pointer".

3.1.1.  ARTICLE (selection by message-id)

   ARTICLE <message-id>

   Display the header, a blank line, then the body (text) of the
   specified article.  Message-id is the message id of an article as
   shown in that article's header.  It is anticipated that the client
   will obtain the message-id from a list provided by the NEWNEWS
   command, from references contained within another article, or from
   the message-id provided in the response to some other commands.

   Please note that the internally-maintained "current article pointer"
   is NOT ALTERED by this command. This is both to facilitate the
   presentation of articles that may be referenced within an article
   being read, and because of the semantic difficulties of determining
   the proper sequence and membership of an article which may have been
   posted to more than one newsgroup.

3.1.2.  ARTICLE (selection by number)

   ARTICLE [nnn]

   Displays the header, a blank line, then the body (text) of the
   current or specified article.  The optional parameter nnn is the

   numeric id of an article in the current newsgroup and must be chosen
   from the range of articles provided when the newsgroup was selected.
   If it is omitted, the current article is assumed.

   The internally-maintained "current article pointer" is set by this
   command if a valid article number is specified.

   [the following applies to both forms of the article command.] A
   response indicating the current article number, a message-id string,
   and that text is to follow will be returned.

   The message-id string returned is an identification string contained
   within angle brackets ("<" and ">"), which is derived from the header
   of the article itself.  The Message-ID header line (required by
   RFC850) from the article must be used to supply this information. If
   the message-id header line is missing from the article, a single
   digit "0" (zero) should be supplied within the angle brackets.

   Since the message-id field is unique with each article, it may be