idnntpserver.pas

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

{ $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:  11693: IdNNTPServer.pas
{
{   Rev 1.30    10/26/2004 10:33:46 PM  JPMugaas
{ Updated refs.
}
{
{   Rev 1.29    5/16/04 5:22:54 PM  RLebeau
{ Added try...finally to CommandPost()
}
{
{   Rev 1.28    3/1/2004 1:02:58 PM  JPMugaas
{ Fixed for new code.
}
{
{   Rev 1.27    2004.02.03 5:44:10 PM  czhower
{ Name changes
}
{
{   Rev 1.26    1/21/2004 3:26:58 PM  JPMugaas
{ InitComponent
}
{
{   Rev 1.25    1/1/04 1:22:04 AM  RLebeau
{ Bug fix for parameter parsing in CommandNewNews() that was testing the
{ ASender.Params.Count incorrectly.
}
{
{   Rev 1.24    2003.10.21 9:13:12 PM  czhower
{ Now compiles.
}
{
    Rev 1.23    10/19/2003 5:39:52 PM  DSiders
  Added localization comments.
}
{
{   Rev 1.22    2003.10.18 9:42:10 PM  czhower
{ Boatload of bug fixes to command handlers.
}
{
{   Rev 1.21    2003.10.12 4:04:02 PM  czhower
{ compile todos
}
{
{   Rev 1.20    9/19/2003 03:30:10 PM  JPMugaas
{ Now should compile again.
}
{
{   Rev 1.19    9/17/2003 10:41:56 PM  PIonescu
{ Fixed small mem leak in CommandPost
}
{
{   Rev 1.18    8/6/2003 6:13:50 PM  SPerry
{ Message-ID Integer - > string
}
{
{   Rev 1.17    8/2/2003 03:53:00 AM  JPMugaas
{ Unit needed to be added to uses clause.
}
{
{   Rev 1.16    8/1/2003 8:21:38 PM  SPerry
{ -
}
{
{   Rev 1.13    5/26/2003 04:28:02 PM  JPMugaas
{ Removed GenerateReply and ParseResponse calls because those functions are
{ being removed.
}
{
{   Rev 1.12    5/26/2003 12:23:48 PM  JPMugaas
}
{
{   Rev 1.11    5/25/2003 03:50:48 AM  JPMugaas
}
{
    Rev 1.10    5/21/2003 2:25:04 PM  BGooijen
  changed due to change in IdCmdTCPServer from ReplyExceptionCode: Integer to
  ReplyException: TIdReply
}
{
{   Rev 1.9    3/26/2003 04:18:26 PM  JPMugaas
{ Now supports implicit and explicit TLS.
}
{
{   Rev 1.7    3/17/2003 08:55:52 AM  JPMugaas
{ Missing reply texts.
}
{
{   Rev 1.6    3/16/2003 08:30:24 AM  JPMugaas
{ Reenabled ExplicitTLS according to
{ http://www.ietf.org/internet-drafts/draft-ietf-nntpext-tls-nntp-00.txt.
{
{ Support is still preliminary.
}
{
    Rev 1.5    1/20/2003 1:15:34 PM  BGooijen
  Changed to TIdTCPServer / TIdCmdTCPServer classes
}
{
{   Rev 1.4    1/17/2003 07:10:40 PM  JPMugaas
{ Now compiles under new framework.
}
{
{   Rev 1.3    1/9/2003 06:09:28 AM  JPMugaas
{ Updated for IdContext API change.
}
{
{   Rev 1.2    1/8/2003 05:53:38 PM  JPMugaas
{ Switched stuff to IdContext.
}
{
{   Rev 1.1    12/7/2002 06:43:14 PM  JPMugaas
{ These should now compile except for Socks server.  IPVersion has to be a
{ property someplace for that.
}
{
{   Rev 1.0    11/13/2002 07:58:00 AM  JPMugaas
}
unit IdNNTPServer;

interface

{
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, IdContext, IdYarn, IdCommandHandlers, IdException,
  IdGlobal, IdServerIOHandler, IdCmdTCPServer, IdExplicitTLSClientServerBase,
  IdTCPConnection, IdTCPServer, IdTStrings;

(*
 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

   335 send article to be transferred.  End with <CR-LF>.<CR-LF>
   340 send article to be posted. End with <CR-LF>.<CR-LF>

   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

   500 command not recognized
   501 command syntax error
   502 access restriction or permission denied
   503 program fault - command not performed
*)

const
  DEF_NNTP_IMPLICIT_TLS = False;

type
  EIdNNTPServerException = class(EIdException);
  EIdNNTPImplicitTLSRequiresSSL = class(EIdNNTPServerException);

  TIdNNTPContext = class(TIdContext)
  protected
    FCurrentArticle: Integer;
    FCurrentGroup: string;
    FUserName: string;
    FPassword: string;
    FAuthenticated : Boolean;
    FModeReader: Boolean;
    function GetUsingTLS:boolean;
  public
    constructor Create(
      AConnection: TIdTCPConnection;
      AYarn: TIdYarn;
      AList: TThreadList = nil
      ); 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;
    property UsingTLS : boolean read GetUsingTLS;
  end;

  TIdNNTPOnAuth = procedure(AThread: TIdNNTPContext; var VAccept: Boolean) of object;
  TIdNNTPOnNewGroupsList = procedure ( AThread: TIdNNTPContext; const ADateStamp : TDateTime; const ADistributions : String) of object;
  TIdNNTPOnNewNews = procedure ( AThread: TIdNNTPContext; const Newsgroups : String; const ADateStamp : TDateTime; const ADistributions : String) of object;
  TIdNNTPOnIHaveCheck = procedure(AThread: TIdNNTPContext; const AMsgID : String; VAccept : Boolean) of object;
  TIdNNTPOnArticleByNo = procedure(AThread: TIdNNTPContext; const AMsgNo: Integer) of object;
  TIdNNTPOnArticleByID = procedure(AThread: TIdNNTPContext; const AMsgID: string) of object;
  TIdNNTPOnCheckMsgNo = procedure(AThread: TIdNNTPContext; const AMsgNo: Integer;
   var VMsgID: string) 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: TIdNNTPContext; var AMsgNo: Integer;
   var VMsgID: string) of object;
  TIdNNTPOnPost = procedure(AThread: TIdNNTPContext; var VPostOk: Boolean;
   var VErrorText: string) of object;
  TIdNNTPOnSelectGroup = procedure(AThread: TIdNNTPContext; const AGroup: string;
   var VMsgCount: Integer; var VMsgFirst: Integer; var VMsgLast: Integer;
   var VGroupExists: Boolean) of object;
  TIdNNTPOnCheckListGroup = procedure(AThread: TIdNNTPContext; const AGroup: string;
   var VCanJoin : Boolean; var VFirstArticle : Integer) of object;
  TIdNNTPOnXOver = procedure(AThread: TIdNNTPContext; const AMsgFirst: Integer;
   const AMsgLast: Integer) of object;
  TIdNNTPOnXHdr = procedure(AThread: TIdNNTPContext; const AHeaderName : String;
    const AMsgFirst: Integer; const AMsgLast: Integer; const AMsgID: String) of object;

  TIdNNTPServer = class(TIdExplicitTLSServer)
  protected
    FImplicitTLS:boolean;
    FHelp: TIdStrings;
    FOverviewFormat: TIdStrings;
    FOnArticleByNo: TIdNNTPOnArticleByNo;
    FOnBodyByNo: TIdNNTPOnArticleByNo;
    FOnHeadByNo: TIdNNTPOnArticleByNo;
    FOnCheckMsgNo: TIdNNTPOnCheckMsgNo;
    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;

    function SecLayerOk(ASender : TIdCommand) : Boolean;
    function AuthOk(ASender: TIdCommand): Boolean;
    //return MsgID - AThread.CurrentArticlePointer already set
    function RawNavigate(AThread: TIdNNTPContext; 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 CommandListExtensions(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 CommandSTARTTLS(ASender: TIdCommand);

    procedure DoListGroups(AThread: TIdNNTPContext);
    procedure DoSelectGroup(AThread: TIdNNTPContext; const AGroup: string; var VMsgCount: Integer;
     var VMsgFirst: Integer; var VMsgLast: Integer; var VGroupExists: Boolean);
    procedure InitializeCommandHandlers; override;
    procedure SetHelp(AValue: TIdStrings);
    procedure SetOverviewFormat(AValue: TIdStrings);
    procedure SetIOHandler(const AValue: TIdServerIOHandler); override;
    procedure SetImplicitTLS(const AValue: Boolean);
    procedure InitComponent; override;
  public
    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: TIdStrings read FHelp write SetHelp;
    property OnArticleByNo: TIdNNTPOnArticleByNo read FOnArticleByNo write FOnArticleByNo;
    property OnAuth: TIdNNTPOnAuth read FOnAuth write FOnAuth;
    property OnBodyByNo: TIdNNTPOnArticleByNo read FOnBodyByNo write FOnBodyByNo;
    property OnHeadByNo: TIdNNTPOnArticleByNo read FOnHeadByNo write FOnHeadByNo;
    property OnCheckMsgNo: TIdNNTPOnCheckMsgNo read FOnCheckMsgNo write FOnCheckMsgNo;
    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: TIdStrings 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;
    property ImplicitTLS : Boolean read FImplicitTLS write SetImplicitTLS default DEF_NNTP_IMPLICIT_TLS;
  end;

implementation

uses
  IdGlobalProtocols,
  IdResourceStringsProtocols,
  IdReply,
  IdReplyRFC,
  IdSSL,
  SysUtils;

resourcestring
  RSNNTPSvrImplicitTLSRequiresSSL='Implicit NNTP requires that IOHandler be set to a TIdSSLIOHandlerSocketBase.';