idnntpserver.pas

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

  end;
  if LCanPost then begin
    LPostOk := False;
    LErrorText := '';
    OnPost(TIdNNTPContext(ASender.Context), LPostOk, LErrorText);
    ASender.Reply.SetReply(iif(LPostOk, 240, 441), LErrorText);
  end;
end;

procedure TIdNNTPServer.CommandSlave(ASender: TIdCommand);
begin
    if SecLayerOk(ASender) then
    begin
      Exit;
    end;
  TIdNNTPContext(ASender.Context).FModeReader := False;
  ASender.Reply.NumericCode := 220;
end;

procedure TIdNNTPServer.CommandStat(ASender: TIdCommand);
var
  s: string;
  LMsgID: string;
  LMsgNo: Integer;
  LThread: TIdNNTPContext;
begin
    if SecLayerOk(ASender) then
    begin
      Exit;
    end;
  if AuthOk(ASender) then begin
    Exit;
  end;
  if Assigned(OnArticleByNo) and Assigned(OnCheckMsgNo) then begin
    LThread := TIdNNTPContext(ASender.Context);
    if Length(LThread.CurrentGroup) = 0 then begin
      ASender.Reply.NumericCode := 412;
    end else begin
      s := Trim(ASender.UnparsedParams);
      // Try as a MsgID
      if Copy(s, 1, 1) = '<' then begin
      // Try as a MsgNo
      end else begin
        LMsgNo := StrToIntDef(s, 0);
        if LMsgNo = 0 then begin
          if LThread.CurrentArticle = 0 then begin
            ASender.Reply.NumericCode := 420;
            Exit;
          end;
          LMsgNo := LThread.CurrentArticle;
        end;
        LMsgID := '';
        OnStatMsgNo(LThread, LMsgNo, LMsgID);
        if (Length(LMsgID) > 0) then begin
          LThread.FCurrentArticle := LMsgNo;
          ASender.Reply.SetReply(220, IntToStr(LMsgNo) + ' ' + LMsgID +
            ' article retrieved - statistics only');  {do not localize}
          ASender.SendReply;
        end else begin
          ASender.Reply.NumericCode := 430;
        end;
      end;
    end;
  end;
end;

procedure TIdNNTPServer.CommandXHdr(ASender: TIdCommand);
var
  i: Integer;
  s: String;
  LFirstMsg: Integer;
  LLastMsg: Integer;
  LMsgID: String;
begin
  if Assigned(FOnXHdr) then begin
      if SecLayerOk(ASender) then
    begin
      Exit;
    end;
    if not AuthOk(ASender) then
    begin
      if Length(TIdNNTPContext(ASender.Context).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);
          LMsgID := '';

          if LFirstMsg = 0 then
          begin
            if (ASender.Params.Count = 2) then { HEADER MSG-ID }
            begin
              LMsgID := ASender.Params[1];
              LFirstMsg := StrToIntDef(LMsgID, 0);
              LLastMsg := LFirstMsg;
            end
            else
            begin
              LFirstMsg := TIdNNTPContext(ASender.Context).CurrentArticle;
              LLastMsg := LFirstMsg;
            end;
          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
            //Note there is an inconstancy here.
            //RFC 2980 says XHDR should return 221
            //http://www.ietf.org/internet-drafts/draft-ietf-nntpext-base-17.txt
            //says that HDR should return 225
            //just return the default numeric success reply.
            ASender.SendReply;
            // No need for DoOnXhdr - only this proc can call it and it already checks for nil
            FOnXhdr(TIdNNTPContext(ASender.Context), ASender.Params[0], LFirstMsg, LLastMsg, LMsgID);
            ASender.Context.Connection.IOHandler.WriteLn('.');
          end;
        end;
      end;
    end;
  end else begin
    ASender.Reply.NumericCode := 500;
//      ASender.Reply.NumericCode := 221;
//      ASender.SendReply;
//      ASender.Context.Connection.WriteLn('.');
  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 Assigned(OnXOver) then begin
    if SecLayerOk(ASender) then
    begin
      Exit;
    end;
    if AuthOk(ASender) then begin
      Exit;
    end;
    if Length(TIdNNTPContext(ASender.Context).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 := TIdNNTPContext(ASender.Context).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(TIdNNTPContext(ASender.Context), LFirstMsg, LLastMsg);
        ASender.Context.Connection.IOHandler.WriteLn('.');
      end;
    end;
  end;
end;

procedure TIdNNTPServer.InitComponent;
begin
  inherited;
  FHelp := TIdStringList.Create;

  FOverviewFormat := TIdStringList.Create;
  with FOverviewFormat do begin
    Add('Subject:');      {do not localize}
    Add('From:');         {do not localize}
    Add('Date:');         {do not localize}
    Add('Message-ID:');   {do not localize}
    Add('References:');   {do not localize}
    Add('Bytes:');        {do not localize}
    Add('Lines:');        {do not localize}
  end;

  FContextClass := TIdNNTPContext;
  FRegularProtPort := IdPORT_NNTP;
  FImplicitTLSProtPort := IdPORT_SNEWS;
  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;
  //

  ExceptionReply.NumericCode := 503;
  ExceptionReply.NumericCode := 500;
  ExceptionReply.Text.Text := RSNNTPServerNotRecognized;
end;

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

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

procedure TIdNNTPServer.DoSelectGroup(AThread: TIdNNTPContext; 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(TIdNNTPContext(AThread), AGroup, VMsgCount, VMsgFirst, VMsgLast, VGroupExists);
  end;
end;

procedure TIdNNTPServer.SetIOHandler(const AValue: TIdServerIOHandler);
//var LIO :  TIdServerIOHandlerSSLBase;
begin
  inherited;
  if IOHandler is  TIdServerIOHandlerSSLBase then
  begin
//    LIO := AValue as TIdSSLIOHandlerSocketBase;
//    LIO.PeerPassthrough := True;
  end
  else
  begin
    ImplicitTLS := False;
  end;
end;

procedure TIdNNTPServer.SetImplicitTLS(const AValue: Boolean);
begin
  if (AValue = FImplicitTLS) then
  begin
    Exit;
  end;
  if (IOHandler is  TIdServerIOHandlerSSLBase) then
  begin
    FImplicitTLS := AValue;
    if AValue then
    begin
      if DefaultPort = IdPORT_NNTP then
      begin
        DefaultPort := IdPORT_SNEWS;
      end;
    end
    else
    begin
      if DefaultPort = IdPORT_SNEWS then
      begin
        DefaultPort := IdPORT_NNTP;
      end;
    end;
  end
  else
  begin
    if AValue then
    begin
      raise EIdNNTPImplicitTLSRequiresSSL.Create( RSNNTPSvrImplicitTLSRequiresSSL );
    end
    else
    begin
      FImplicitTLS := AValue;
    end;
  end;
end;

procedure TIdNNTPServer.CommandSTARTTLS(ASender: TIdCommand);

var LIO : TIdSSLIOHandlerSocketBase;
  LCxt : TIdNNTPContext;
begin
  if (IOHandler is TIdServerIOHandlerSSLBase) and (ImplicitTLS=False) then begin
    if TIdNNTPContext(ASender.Context).UsingTLS then begin // we are already using TLS
      ASender.Reply.NumericCode:=500;                                        // does someone know the response-code?
      Exit;
    end;
    if (ASender.Context as TIdNNTPContext).UsingTLS then
    begin
      ASender.Reply.NumericCode := 580;
    end
    else
    begin