idnntpserver.pas

Indy控件的使用源代码

     3.3.2.  Responses

     100 help text follows
  *)
  with CommandHandlers.Add do begin
    Command := 'HELP';
    ReplyNormal.NumericCode := 100;
    if FHelp.Count = 0 then begin
      Response.Add('No help available.');
    end else begin
      Response.Assign(FHelp);
    end;
    ParseParams := False;
  end;
  with CommandHandlers.Add do begin
    Command := 'GROUP';
    OnCommand := CommandGroup;
    ReplyNormal.NumericCode := 411;
    ParseParams := False;
  end;
  with CommandHandlers.Add do begin
    Command := 'IHAVE';
    OnCommand := CommandIHave;
    ParseParams := False;
  end;
  with CommandHandlers.Add do begin
    Command := 'LAST';
    OnCommand := CommandLast;
    ParseParams := False;
  end;
  (*
  2.1.7 LIST OVERVIEW.FMT

     LIST OVERVIEW.FMT

     The overview.fmt file is maintained by some news transport systems to
     contain the order in which header information is stored in the
     overview databases for each news group.  When executed, news article
     header fields are displayed one line at a time in the order in which
     they are stored in the overview database [5] following the 215
     response.  When display is completed, the server will send a period
     on a line by itself.  If the information is not available, the server
     will return the 503 response.

     Please note that if the header has the word "full" (without quotes)
     after the colon, the header's name is prepended to its field in the
     output returned by the server.

     Many newsreaders work better if Xref: is one of the optional fields.

     It is STRONGLY recommended that this command be implemented in any
     server that implements the XOVER command.  See section 2.8 for more
     details about the XOVER command.

  2.1.7.1 Responses

        215 information follows
        503 program error, function not performed
  *)
  // Before LIST
  with CommandHandlers.Add do begin
    Command := 'LIST Overview.fmt';
    if OverviewFormat.Count > 0 then begin
      ReplyNormal.NumericCode := 215;
      Response.Assign(OverviewFormat);
    end else begin
      ReplyNormal.NumericCode := 503;
    end;
    ParseParams := False;
  end;
  // Before LIST
  //TODO: This needs implemented as events to allow return data
  // RFC 2980 - NNTP Extension
  with CommandHandlers.Add do begin
    Command := 'LIST NEWSGROUPS';
    ReplyNormal.NumericCode := 215;
    Response.Add('.');
    ParseParams := False;
  end;
  with CommandHandlers.Add do begin
    Command := 'LIST';
    OnCommand := CommandList;
    ReplyNormal.NumericCode := 215;
    ParseParams := False;
  end;
  with CommandHandlers.Add do begin
    Command := 'LISTGROUP';
    OnCommand := CommandListGroup;
    ParseParams := False;
  end;
  with CommandHandlers.Add do begin
    Command := 'MODE READER';
    OnCommand := CommandModeReader;
    ParseParams := False;
  end;
  with CommandHandlers.Add do begin
    Command := 'NEWGROUPS';
    OnCommand := CommandNewGroups;
    ReplyNormal.NumericCode := 231;
  end;
  with CommandHandlers.Add do begin
    Command := 'NEWNEWS';
    OnCommand := CommandNewNews;
    ParseParams := False;
  end;
  with CommandHandlers.Add do begin
    Command := 'NEXT';
    OnCommand := CommandNext;
    ParseParams := False;
  end;
  with CommandHandlers.Add do begin
    Command := 'POST';
    OnCommand := CommandPost;
    ParseParams := False;
  end;
  (*
  3.11.  The QUIT command

  3.11.1.  QUIT

     QUIT

     The server process acknowledges the QUIT command and then closes the
     connection to the client.  This is the preferred method for a client
     to indicate that it has finished all its transactions with the NNTP
     server.

     If a client simply disconnects (or the connection times out, or some
     other fault occurs), the server should gracefully cease its attempts
     to service the client.

  3.11.2.  Responses

     205 closing connection - goodbye!
  *)
  with CommandHandlers.Add do begin
    Command := 'QUIT';
    Disconnect := True;
    ReplyNormal.NumericCode := 205;
    ParseParams := False;
  end;
  with CommandHandlers.Add do begin
    Command := 'SLAVE';
    OnCommand := CommandSlave;
    ParseParams := False;
  end;
  with CommandHandlers.Add do begin
    Command := 'STAT';
    OnCommand := CommandStat;
    ParseParams := False;
  end;
  with CommandHandlers.Add do begin
    Command := 'XHDR';
    OnCommand := CommandXHdr;
    ParseParams := True;
  end;
  with CommandHandlers.Add do begin
    Command := 'XOVER';
    OnCommand := CommandXOver;
    ReplyNormal.NumericCode := 500;
    ParseParams := False;
  end;
  with ReplyTexts do begin
    // 100s
    Add(100, 'help text follows');
    Add(199, 'debug output');
    // 200s
    Add(200, 'server ready - posting allowed');
    Add(201, 'server ready - no posting allowed');
    Add(202, 'slave status noted');
    Add(205, 'closing connection - goodbye!');
    Add(215, 'list of newsgroups follows');
    Add(231, 'list of new newsgroups follows');
    Add(235, 'article transferred ok');
    Add(240, 'article posted ok');
    
    Add(281, 'authentication accepted');
    // 300s
    Add(335, 'send article to be transferred. End with <CR-LF>.<CR-LF>');
    Add(340, 'send article to be posted. End with <CR-LF>.<CR-LF>');
    Add(381, 'more authentication information required');
    // 400s
    Add(400, 'service discontinued');
    Add(411, 'no such news group');
    Add(412, 'no newsgroup has been selected');
    Add(420, 'no current article has been selected');
    Add(421, 'no next article in this group');
    Add(422, 'no previous article in this group');
    Add(423, 'no such article number in this group');
    Add(430, 'no such article found');
    Add(435, 'article not wanted - do not send it');
    Add(436, 'transfer failed - try again later');
    Add(437, 'article rejected - do not try again.');
    Add(440, 'posting not allowed');
    Add(441, 'posting failed');
    Add(450, 'Authorization required for this command');
    Add(452, 'Authorization rejected');
    Add(480, 'Authentication required');
    Add(482, 'Authentication rejected');
    // 500s
    Add(500, 'command not recognized');
    Add(501, 'command syntax error');
    Add(502, 'access restriction or permission denied');
    Add(503, 'program fault - command not performed');
  end;
end;

function TIdNNTPServer.AuthRequired(ASender: TIdCommand): Boolean;
var
  LRequired : boolean;
begin
  Result := False;
  if Assigned(FOnAuth) and (TIdNNTPThread(ASender.Thread).Authenticated = False)
   then begin
    LRequired := True;
    if Assigned(OnAuthRequired) then begin
      OnAuthRequired(TIdNNTPThread(ASender.Thread)
       , ASender.CommandHandler.Command, ASender.UnparsedParams, LRequired);
    end;
    Result := LRequired;
    if Result then begin
      ASender.Reply.NumericCode := 450
    end;
  end;
end;

function TIdNNTPServer.RawNavigate(AThread: TIdNNTPThread;
  AEvent: TIdNNTPOnMovePointer): String;
var LMsgNo : Integer;
begin
  Result := '';
  LMsgNo := AThread.CurrentArticle;
  if (AThread.CurrentArticle > 0) then
  begin
    AEvent(AThread,LMsgNo,Result);
    if (LMsgNo > 0) and (LMsgNo <> AThread.CurrentArticle) and (Result <> '') then
    begin
      AThread.FCurrentArticle := LMsgNo;
    end;
  end;
end;

procedure TIdNNTPServer.SetHelp(AValue: TStrings);
begin
  FHelp.Assign(AValue);
end;

{ TIdNNTPThread }

constructor TIdNNTPThread.Create(ACreateSuspended: Boolean);
begin
  inherited;
  FCurrentArticle := 0;
end;

procedure TIdNNTPServer.SetOverviewFormat(AValue: TStrings);
begin
  FOverviewFormat.Assign(AValue);
end;

(*
3.1 AUTHINFO

   AUTHINFO is used to inform a server about the identity of a user of
   the server.  In all cases, clients must provide this information when
   requested by the server.  Servers are not required to accept
   authentication information that is volunteered by the client.
   Clients must accommodate servers that reject any authentication
   information volunteered by the client.

   There are three forms of AUTHINFO in use.  The original version, an
   NNTP v2 revision called AUTHINFO SIMPLE and a more recent version
   which is called AUTHINFO GENERIC.

3.1.1 Original AUTHINFO

   AUTHINFO USER username
   AUTHINFO PASS password

   The original AUTHINFO is used to identify a specific entity to the
   server using a simple username/password combination.  It first
   appeared in the UNIX reference implementation.

   When authorization is required, the server will send a 480 response
   requesting authorization from the client.  The client must enter
   AUTHINFO USER followed by the username.  Once sent, the server will
   cache the username and may send a 381 response requesting the
   password associated with that username.  Should the server request a
   password using the 381 response, the client must enter AUTHINFO PASS
   followed by a password and the server will then check the
   authentication database to see if the username/password combination
   is valid.  If the combination is valid or if no password is required,
   the server will return a 281 response.  The client should then retry
   the original command to which the server responded with the 480
   response.  The command should then be processed by the server
   normally.  If the combination is not valid, the server will return a
   502 response.

   Clients must provide authentication when requested by the server.  It
   is possible that some implementations will accept authentication
   information at the beginning of a session, but this was not the
   original intent of the specification.  If a client attempts to
   reauthenticate, the server may return 482 response indicating that
   the new authentication data is rejected by the server.  The 482 code
   will also be returned when the AUTHINFO commands are not entered in
   the correct sequence (like two AUTHINFO USERs in a row, or AUTHINFO
   PASS preceding AUTHINFO USER).

   All information is passed in cleartext.

   When authentication succeeds, the server will create an email address
   for the client from the user name supplied in the AUTHINFO USER
   command and the hostname generated by a reverse lookup on the IP
   address of the client.  If the reverse lookup fails, the IP address,
   represented in dotted-quad format, will be used.  Once authenticated,
   the server shall generate a Sender:  line using the email address
   provided by authentication if it does not match the client-supplied
   From: line.  Additionally, the server should log the event, including
   the email address.  This will provide a means by which subsequent
   statistics generation can associate newsgroup references with unique
   entities - not necessarily by name.

3.1.1.1 Responses

      281 Authentication accepted
      381 More authentication information required
      480 Authentication required
      482 Authentication rejected
      502 No permission
*)
procedure TIdNNTPServer.CommandAuthInfoPassword(ASender: TIdCommand);
var
  LThread: TIdNNTPThread;
begin
  if Assigned(FOnAuth) then begin
    if ASender.Params.Count = 1 then begin
      LThread := TIdNNTPThread(ASender.Thread);
      LThread.FPassword := ASender.Params[0];
      FOnAuth(LThread, LThread.FAuthenticated);
      if LThread.FAuthenticated then begin
        ASender.Reply.NumericCode := 281;
      end;
    end;
  end else ASender.Reply.NumericCode := 500; 
end;

procedure TIdNNTPServer.CommandAuthInfoUser(ASender: TIdCommand);
var
  LThread: TIdNNTPThread;
begin
  if Assigned(FOnAuth) then begin
    if ASender.Params.Count = 1 then begin
      LThread := TIdNNTPThread(ASender.Thread);
      LThread.FUsername := ASender.Params[0];
      FOnAuth(LThread, LThread.FAuthenticated);
      if LThread.FAuthenticated then begin
        ASender.Reply.NumericCode := 281;
      end else begin
        ASender.Reply.NumericCode := 381;
      end;
    end;
  end else ASender.Reply.NumericCode := 500; 
end;

function TIdNNTPServer.LookupMessage(ASender : TidCommand;
  var VNo: Integer; var VId: string): boolean;
var
  s : string;
  LThread : TidNNTPThread;
begin
  result := False;
  LThread := TidNNTPThread (ASender.Thread);

  if LThread.CurrentGroup = '' then
    ASender.Reply.NumericCode := 412
  else
  begin
    s := Trim(ASender.UnparsedParams);
    VId := '';

    if s = '' then
      VNo := LThread.CurrentArticle
    else
      VNo := StrToIntDef (s, 0);

    if VNo = 0 then
    begin
      if s = '' then
        ASender.Reply.NumericCode := 420  // Current article no not set.
      else
      begin
        if Copy (s, 1, 1) = '<' then
          if Assigned (OnCheckMsgID) then
            OnCheckMsgID (LThread, s, VNo);

        if VNo <> 0 then
          VId := s
        else
          ASender.Reply.NumericCode := 430 // Article not found
      end
    end
    else
    begin

      if Assigned (OnCheckMsgNo) then
        OnCheckMsgNo (LThread, VNo, VId);

      if VId <> '' then
        LThread.FCurrentArticle := VNo
      else
        ASender.Reply.NumericCode := 423  // Article no does not exist
    end;
    result := (vNo > 0) and (vId <> '');
  end
end;

end.