idnntpserver.pas

delphi indy9.0.18组件包

{ $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.8    2/9/04 9:22:26 PM  RLebeau
{ Updated to support more extensions from RFC 2980
}
{
{   Rev 1.7    1/29/04 9:27:46 PM  RLebeau
{ Updated CommandPost() to wrap the LReply object in a try...finally block.
}
{
{   Rev 1.6    1/1/04 1:17:46 AM  RLebeau
{ Bug fix for parameter parsing in CommandNewNews() that was testing the
{ ASender.Params.Count incorrectly.
}
{
{   Rev 1.5    9/17/2003 7:28:10 PM  PIonescu
{ Fixed small mem leak in CommandPost
}
{
{   Rev 1.4    8/6/2003 6:16:26 PM  SPerry
{ Message-ID Integer - > string
}
{
{   Rev 1.3    8/1/2003 8:53:22 PM  SPerry
{ XHDR command MessageID
}
{
{   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
 http://www.ietf.org/internet-drafts/draft-ietf-nntpext-base-20.txt
*)

(*
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
  TIdNNTPAuthType = (atUserPass, atSimple, atGeneric);
  TIdNNTPAuthTypes = set of TIdNNTPAuthType;

  TIdNNTPThread = class(TIdPeerThread)
  protected
    FCurrentArticle: Integer;
    FCurrentGroup: string;
    FUserName: string;
    FPassword: string;
    FAuthenticator: string;
    FAuthParams: string;
    FAuthenticated: Boolean;
    FAuthType: TIdNNTPAuthType;
    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 Authenticator: string read FAuthenticator;
    property AuthParams: string read FAuthParams;
    property Authenticated: Boolean read FAuthenticated;
    property AuthType: TIdNNTPAuthType read FAuthType;
  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;
  TIdNNTPOnXHdr = procedure(AThread: TIdNNTPThread; const AHeaderName : String; const AMsgFirst: Integer;
   const AMsgLast: Integer; const AMsgID: String) of object;
  TIdNNTPOnXOver = procedure(AThread: TIdNNTPThread; const AMsgFirst: Integer;
   const AMsgLast: Integer) of object;
  TIdNNTPOnXPat = procedure(AThread: TIdNNTPThread; const AHeaderName : String; const AMsgFirst: Integer;
   const AMsgLast: Integer; const AMsgID: String; const AHeaderPattern: String) of object;
  TIdNNTPOnAuthRequired = procedure(AThread: TIdNNTPThread; const ACommand, AParams : string; var VRequired: Boolean) of object;
  TIdNNTPOnListPattern = procedure(AThread: TIdNNTPThread; const AGroupPattern: String) of object;

  TIdNNTPServer = class(TIdTCPServer)
  private
  protected
    FHelp: TStrings;
    FDistributionPatterns: TStrings;
    FOverviewFormat: TStrings;
    FSupportedAuthTypes: TIdNNTPAuthTypes;
    FOnArticleByNo: TIdNNTPOnArticleByNo;
    FOnBodyByNo: TIdNNTPOnArticleByNo;
    FOnHeadByNo: TIdNNTPOnArticleByNo;
    FOnCheckMsgNo: TIdNNTPOnCheckMsgNo;
    FOnCheckMsgId: TidNNTPOnCheckMsgId;
    FOnStatMsgNo : TIdNNTPOnMovePointer;
    FOnNextArticle : TIdNNTPOnMovePointer;
    FOnPrevArticle : TIdNNTPOnMovePointer;
    //LISTGROUP events - Gravity uses these
    FOnCheckListGroup : TIdNNTPOnCheckListGroup;
    FOnListActiveGroups: TIdNNTPOnListPattern;
    FOnListActiveGroupTimes: TIdNNTPOnListPattern;
    FOnListDescriptions : TIdNNTPOnListPattern;
    FOnListDistributions : TIdServerThreadEvent;
    FOnListExtensions: TIdServerThreadEvent;
    FOnListHeaders: TIdServerThreadEvent;
    FOnListSubscriptions : TIdServerThreadEvent;
    FOnListGroup : TIdServerThreadEvent;
    FOnListGroups: TIdServerThreadEvent;
    FOnListNewGroups : TIdNNTPOnNewGroupsList;
    FOnPost: TIdNNTPOnPost;
    FOnSelectGroup: TIdNNTPOnSelectGroup;
    FOnXHdr: TIdNNTPOnXHdr;
    FOnXOver: TIdNNTPOnXOver;
    FOnXROver: TIdNNTPOnXOver;
    FOnXPat: TIdNNTPOnXPat;
    FOnNewNews : TIdNNTPOnNewNews;
    FOnIHaveCheck : TIdNNTPOnIHaveCheck;
    FOnIHavePost: TIdNNTPOnPost;
    FOnAuth: TIdNNTPOnAuth;
    FOnAuthRequired: TIdNNTPOnAuthRequired;

    function AuthRequired(ASender: TIdCommand): Boolean;
    function DoCheckMsgID(AThread: TIdNNTPThread; const AMsgID: String): Integer;
    //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 CommandAuthInfoSimple(ASender: TIdCommand);
    procedure CommandAuthInfoGeneric(ASender: TIdCommand);
    procedure CommandBody(ASender: TIdCommand);
    procedure CommandDate(ASender: TIdCommand);
    procedure CommandHead(ASender: TIdCommand);
    procedure CommandHelp(ASender: TIdCommand);
    procedure CommandGroup(ASender: TIdCommand);
    procedure CommandIHave(ASender: TIdCommand);
    procedure CommandLast(ASender: TIdCommand);
    procedure CommandList(ASender: TIdCommand);
    procedure CommandListActiveGroups(ASender: TIdCommand);
    procedure CommandListActiveTimes(ASender: TIdCommand);
    procedure CommandListDescriptions(ASender: TidCommand);
    procedure CommandListDistributions(ASender: TIdCommand);
    procedure CommandListDistribPats(ASender: TIdCommand);
    procedure CommandListExtensions(ASender: TIdCommand);
    procedure CommandListHeaders(ASender: TIdCommand);
    procedure CommandListSubscriptions(ASender: TIdCommand);
    procedure CommandListGroup(ASender: TIdCommand);
    procedure CommandListOverview(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 CommandXROver(ASender: TIdCommand);
    procedure CommandXPat(ASender: TIdCommand);
    procedure DoSelectGroup(AThread: TIdNNTPThread; const AGroup: string; var VMsgCount: Integer;
     var VMsgFirst: Integer; var VMsgLast: Integer; var VGroupExists: Boolean);
    procedure InitializeCommandHandlers; override;
    procedure SetDistributionPatterns(AValue: TStrings);
    procedure SetHelp(AValue: TStrings);
    procedure SetOverviewFormat(AValue: TStrings);
    function LookupMessage(ASender : TidCommand; var VNo : Integer; var VId : string) : Boolean;
    function LookupMessageRange(ASender: TIdCommand; const AData: String;
      var VMsgFirst: Integer; var VMsgLast: Integer) : Boolean;
    function LookupMessageRangeOrID(ASender: TIdCommand; const AData: String;
      var VMsgFirst: Integer; var VMsgLast: Integer; var VMsgID: 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 DistributionPatterns: TStrings read FDistributionPatterns
      write SetDistributionPatterns;
    property Help: TStrings read FHelp write SetHelp;
    property SupportedAuthTypes: TIdNNTPAuthTypes read FSupportedAuthTypes
      write FSupportedAuthTypes;
    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 OnListActiveGroups: TIdNNTPOnListPattern read FOnListActiveGroups
      write FOnListActiveGroups;
    property OnListActiveGroupTimes: TIdNNTPOnListPattern read FOnListActiveGroupTimes
      write FOnListActiveGroupTimes;
    property OnListDescriptions : TIdNNTPOnListPattern read FOnListDescriptions
      write FOnListDescriptions;
    property OnListDistributions : TIdServerThreadEvent read FOnListDistributions
      write FOnListDistributions;