PageRenderTime 55ms CodeModel.GetById 19ms RepoModel.GetById 0ms app.codeStats 1ms

/ProSnooperFx_src/indy10.0.52_source/Protocols/IdNNTP.pas

http://github.com/lookias/ProSnooper
Pascal | 1387 lines | 779 code | 87 blank | 521 comment | 55 complexity | 2473b9d43296fa6d913de9a622713b2e MD5 | raw file
  1. { $HDR$}
  2. {**********************************************************************}
  3. { Unit archived using Team Coherence }
  4. { Team Coherence is Copyright 2002 by Quality Software Components }
  5. { }
  6. { For further information / comments, visit our WEB site at }
  7. { http://www.TeamCoherence.com }
  8. {**********************************************************************}
  9. {}
  10. { $Log: 11691: IdNNTP.pas
  11. {
  12. { Rev 1.27 10/26/2004 10:33:46 PM JPMugaas
  13. { Updated refs.
  14. }
  15. {
  16. { Rev 1.26 2004.05.20 11:37:02 AM czhower
  17. { IdStreamVCL
  18. }
  19. {
  20. { Rev 1.25 16/05/2004 14:30:42 CCostelloe
  21. { ReceiveHeader checks added in case message has no body
  22. }
  23. {
  24. { Rev 1.24 3/7/2004 11:21:50 PM JPMugaas
  25. { Compiler warnings.
  26. }
  27. {
  28. { Rev 1.23 2004.03.06 1:31:46 PM czhower
  29. { To match Disconnect changes to core.
  30. }
  31. {
  32. { Rev 1.22 2004.02.03 5:44:10 PM czhower
  33. { Name changes
  34. }
  35. {
  36. { Rev 1.21 2004.01.28 9:36:32 PM czhower
  37. { Fixed search and replace error
  38. }
  39. {
  40. { Rev 1.20 2004.01.27 1:13:36 PM czhower
  41. { T --> TId
  42. { var --> out
  43. }
  44. {
  45. { Rev 1.19 1/26/2004 1:16:46 PM JPMugaas
  46. { SSL Reenabled.
  47. }
  48. {
  49. { Rev 1.18 2004.01.22 9:28:44 PM czhower
  50. { DotNetExclude for TLS.
  51. }
  52. {
  53. { Rev 1.17 1/21/2004 3:26:50 PM JPMugaas
  54. { InitComponent
  55. }
  56. {
  57. { Rev 1.16 1/5/2004 8:22:18 PM JMJacobson
  58. { Updated TIdNNTP.GetCapability to handle empty LIST EXTENSIONS response
  59. { (response 215)
  60. }
  61. {
  62. { Rev 1.15 11/11/03 11:06:18 AM RLebeau
  63. { Updated SendCmd() to test for a 281 response when issuing an AUTHINFO USER
  64. { command, as per RFC 2980
  65. }
  66. {
  67. { Rev 1.14 2003.10.24 10:33:22 AM czhower
  68. { Saved first this time.
  69. }
  70. {
  71. Rev 1.12 10/19/2003 5:31:52 PM DSiders
  72. Added localization comments.
  73. }
  74. {
  75. { Rev 1.11 2003.10.14 9:57:16 PM czhower
  76. { Compile todos
  77. }
  78. {
  79. { Rev 1.10 2003.10.12 4:04:00 PM czhower
  80. { compile todos
  81. }
  82. {
  83. { Rev 1.9 9/10/2003 03:26:12 AM JPMugaas
  84. { Updated GetArticle(), GetBody(), and GetHeader() to use new
  85. { EnsureMsgIDBrackets() function in IdGlobal. Checked in on behalf of Remy
  86. { Lebeau
  87. }
  88. {
  89. { Rev 1.8 6/9/2003 05:14:58 AM JPMugaas
  90. { Fixed crical error.
  91. { Supports HDR and OVER commands defined in
  92. { http://www.ietf.org/internet-drafts/draft-ietf-nntpext-base-18.txt if feature
  93. { negotiation indicates that they are supported.
  94. { Added XHDR data parsing routine.
  95. { Added events for when we receive a line of data with XOVER or XHDR as per
  96. { John Jacobson's request.
  97. }
  98. {
  99. { Rev 1.7 6/9/2003 01:09:40 AM JPMugaas
  100. { Host wasn't published when it should have been published.
  101. }
  102. {
  103. { Rev 1.6 6/5/2003 04:54:00 AM JPMugaas
  104. { Reworkings and minor changes for new Reply exception framework.
  105. }
  106. {
  107. { Rev 1.5 5/8/2003 11:28:06 AM JPMugaas
  108. { Moved feature negoation properties down to the ExplicitTLSClient level as
  109. { feature negotiation goes hand in hand with explicit TLS support.
  110. }
  111. {
  112. { Rev 1.4 4/5/2003 02:06:20 PM JPMugaas
  113. { TLS handshake itself can now be handled.
  114. }
  115. {
  116. { Rev 1.3 3/27/2003 05:46:36 AM JPMugaas
  117. { Updated framework with an event if the TLS negotiation command fails.
  118. { Cleaned up some duplicate code in the clients.
  119. }
  120. {
  121. { Rev 1.2 3/26/2003 04:18:22 PM JPMugaas
  122. { Now supports implicit and explicit TLS.
  123. }
  124. {
  125. { Rev 1.1 2/24/2003 09:25:16 PM JPMugaas
  126. }
  127. {
  128. { Rev 1.0 11/13/2002 07:57:52 AM JPMugaas
  129. }
  130. unit IdNNTP;
  131. interface
  132. uses
  133. Classes,
  134. IdAssignedNumbers, IdExplicitTLSClientServerBase, IdException, IdStreamVCL,
  135. IdMessage, IdMessageClient, IdReplyRFC,
  136. IdTCPServer, IdTCPConnection, IdTStrings;
  137. {
  138. 2001-Dec - Chad Z. Hower a.k.a. Kudzu
  139. -Continued modifications
  140. 2001-Oct - Chad Z. Hower a.k.a. Kudzu
  141. -Massive reworking to fit the Indy 9 model and update a lot of outdated code
  142. that was left over from Delphi 4 days. Updates now use overloaded functins. There were also
  143. several problems with message number accounting.
  144. 2000-Jun-23 J. Peter Mugaas
  145. -GetNewGroupsList, GetNewGroupsList, and GetNewNewsList No longer require
  146. an Event handler if you provide a TStrings to those procedures
  147. -ParseXOVER was added so that you could parse XOVER data
  148. -ParseNewsGroup was ripped from GetNewGroupsList so that newsgroups can
  149. be parsed while not downloading newsgroups
  150. -Moved some duplicate code into a separate procedure
  151. -The IdNNTP now uses the Indy exceptions and IdResourceStrings to facilitate
  152. internationalization
  153. 2000-Apr=28 Mark L. Holmes
  154. -Ported to Indy
  155. 2000-Apr-28
  156. -Final Version
  157. 1999-Dec-29 MTL
  158. -Moved to new Palette Scheme (Winshoes Servers)
  159. Ammended and modified by: AHeid, Mark Holmes
  160. Original Author: Chad Z. Hower a.k.a. Kudzu
  161. }
  162. type
  163. // Most users of this component should use "mtReader"
  164. TIdModeType = (mtStream, mtIHAVE, mtReader);
  165. TIdNNTPPermission = (crCanPost, crNoPost, crAuthRequired, crTempUnavailable);
  166. TIdModeSetResult = (mrCanStream, mrNoStream, mrCanIHAVE, mrNoIHAVE, mrCanPost, mrNoPost);
  167. TIdEventStreaming = procedure (AMesgID: string; var AAccepted: Boolean)of object;
  168. TIdNewsTransporTIdEvent = procedure (AMsg: TIdStringList) of object;
  169. //AMsg can be an index number or a message ID depending upon the parameters of XHDR
  170. TIdEvenTIdNewsgroupList = procedure(ANewsgroup: string; ALow, AHigh: Integer;
  171. AType: string; var ACanContinue: Boolean) of object;
  172. TIdEventXOVER = procedure(AArticleIndex : Integer; ASubject,
  173. AFrom : String; ADate : TDateTime; AMsgId, AReferences : String; AByteCount,
  174. ALineCount : Integer; AExtraData : String; var VCanContinue : Boolean) of object;
  175. TIdEventNewNewsList = procedure(AMsgID: string; var ACanContinue: Boolean) of object;
  176. TIdEventXHDREntry = procedure(AHeader : String; AMsg, AHeaderData : String; var ACanContinue: Boolean) of object;
  177. //TODO: Add a TranslateRFC822 Marker - probably need to do it in TCPConnection and modify Capture
  178. // Better yet, make capture an object
  179. TIdNNTP = class(TIdMessageClient)
  180. protected
  181. FlMsgHigh: Integer;
  182. FlMsgLow: Integer;
  183. FlMsgCount: Integer;
  184. FNewsAgent: string;
  185. FOnNewsgroupList,
  186. FOnNewGroupsList: TIdEvenTIdNewsgroupList;
  187. FOnNewNewsList: TIdEventNewNewsList;
  188. FOnXHDREntry : TIdEventXHDREntry;
  189. FOnXOVER : TIdEventXOVER;
  190. FModeType: TIdModeType;
  191. FModeResult: TIdModeSetResult;
  192. FPermission: TIdNNTPPermission;
  193. FHDRSupported : Boolean;
  194. FOVERSupported : Boolean;
  195. //
  196. procedure AfterConnect;
  197. procedure GetCapability;
  198. function ConvertDateTimeDist(ADate: TDateTime; AGMT: boolean;
  199. ADistributions: string): string;
  200. function GetSupportsTLS : boolean; override;
  201. procedure InitComponent; override;
  202. procedure ProcessGroupList(ACmd: string; AResponse: integer;
  203. ALisTIdEvent: TIdEvenTIdNewsgroupList);
  204. procedure XHDRCommon(AHeader, AParam : String);
  205. procedure XOVERCommon(AParam : String);
  206. procedure StartTLS;
  207. public
  208. procedure Check(AMsgIDs: TIdStringList; var AResponses: TIdStringList);
  209. procedure Connect; override;
  210. destructor Destroy; override;
  211. procedure DisconnectNotifyPeer; override;
  212. function GetArticle(AMsg: TIdMessage): Boolean; overload;
  213. function GetArticle(AMsgNo: Integer; AMsg: TIdMessage): Boolean; overload;
  214. function GetArticle(AMsgID: string; AMsg: TIdMessage): Boolean; overload;
  215. function GetArticle(AMsg: TIdStrings): Boolean; overload;
  216. function GetArticle(AMsgNo: Integer; AMsg: TIdStrings): Boolean; overload;
  217. function GetArticle(AMsgID: string; AMsg: TIdStrings): Boolean; overload;
  218. function GetArticle(AMsg: TStream): Boolean; overload;
  219. function GetArticle(AMsgNo: Integer; AMsg: TStream): Boolean; overload;
  220. function GetArticle(AMsgID: string; AMsg: TStream): Boolean; overload;
  221. function GetBody(AMsg: TIdMessage): Boolean; overload;
  222. function GetBody(AMsgNo: Integer; AMsg: TIdMessage): Boolean; overload;
  223. function GetBody(AMsgID: string; AMsg: TIdMessage): Boolean; overload;
  224. function GetBody(AMsg: TIdStrings): Boolean; overload;
  225. function GetBody(AMsgNo: Integer; AMsg: TIdStrings): Boolean; overload;
  226. function GetBody(AMsgID: string; AMsg: TIdStrings): Boolean; overload;
  227. function GetBody(AMsg: TStream): Boolean; overload;
  228. function GetBody(AMsgNo: Integer; AMsg: TStream): Boolean; overload;
  229. function GetBody(AMsgID: string; AMsg: TStream): Boolean; overload;
  230. function GetHeader(AMsg: TIdMessage): Boolean; overload;
  231. function GetHeader(AMsgNo: Integer; AMsg: TIdMessage): Boolean; overload;
  232. function GetHeader(AMsgID: string; AMsg: TIdMessage): Boolean; overload;
  233. function GetHeader(AMsg: TIdStrings): Boolean; overload;
  234. function GetHeader(AMsgNo: Integer; AMsg: TIdStrings): Boolean; overload;
  235. function GetHeader(AMsgID: string; AMsg: TIdStrings): Boolean; overload;
  236. function GetHeader(AMsg: TStream): Boolean; overload;
  237. function GetHeader(AMsgNo: Integer; AMsg: TStream): Boolean; overload;
  238. function GetHeader(AMsgID: string; AMsg: TStream): Boolean; overload;
  239. procedure GetNewsgroupList; overload;
  240. procedure GetNewsgroupList(AList: TIdStrings); overload;
  241. procedure GetNewsgroupList(AStream: TStream); overload;
  242. procedure GetNewGroupsList(ADate: TDateTime; AGMT: boolean;
  243. ADistributions: string); overload;
  244. procedure GetNewGroupsList(ADate: TDateTime; AGMT: boolean;
  245. ADistributions: string; AList : TIdStrings); overload;
  246. procedure GetNewNewsList(ANewsgroups: string;
  247. ADate: TDateTime; AGMT: boolean; ADistributions: string); overload;
  248. procedure GetNewNewsList(ANewsgroups: string; ADate: TDateTime;
  249. AGMT: boolean; ADistributions: string; AList : TIdStrings); overload;
  250. procedure GetOverviewFMT(AResponse: TIdStringList);
  251. function IsExtCmdSupported(AExtension : String) : Boolean;
  252. procedure IHAVE(AMsg: TIdStringList);
  253. function Next: Boolean;
  254. function Previous: Boolean;
  255. procedure ParseXOVER(Aline: String; var AArticleIndex : Integer; var ASubject,
  256. AFrom : String; var ADate : TDateTime; var AMsgId, AReferences : String; var AByteCount,
  257. ALineCount : Integer; var AExtraData : String);
  258. procedure ParseNewsGroup(ALine : String; out ANewsGroup: string; out AHi, ALo : Integer;
  259. out AStatus : String);
  260. procedure ParseXHDRLine(ALine : String; out AMsg : String; out AHeaderData : String);
  261. procedure Post(AMsg: TIdMessage); overload;
  262. procedure Post(AStream: TIdStreamVCL); overload;
  263. function SendCmd(AOut: string; const AResponse: array of SmallInt): SmallInt; override;
  264. function SelectArticle(AMsgNo: Integer): Boolean;
  265. procedure SelectGroup(AGroup: string);
  266. function TakeThis(AMsgID: string; AMsg: TIdStreamVCL): string;
  267. procedure XHDR(AHeader: string; AParam: string; AResponse: TIdStrings); overload;
  268. procedure XHDR(AHeader: string; AParam: string); overload;
  269. procedure XOVER(AParam: string; AResponse: TIdStrings); overload;
  270. procedure XOVER(AParam: string; AResponse: TStream); overload;
  271. procedure XOVER(AParam: string); overload;
  272. //
  273. property ModeResult: TIdModeSetResult read FModeResult write FModeResult;
  274. property MsgCount: Integer read flMsgCount;
  275. property MsgHigh: Integer read FlMsgHigh;
  276. property MsgLow: Integer read FlMsgLow;
  277. property Permission: TIdNNTPPermission read FPermission;
  278. published
  279. property NewsAgent: string read FNewsAgent write FNewsAgent;
  280. property Mode: TIdModeType read FModeType write FModeType default mtReader;
  281. property Password;
  282. property Username;
  283. property OnNewsgroupList: TIdEvenTIdNewsgroupList read FOnNewsgroupList write FOnNewsgroupList;
  284. property OnNewGroupsList: TIdEvenTIdNewsGroupList read FOnNewGroupsList write FOnNewGroupsList;
  285. property OnNewNewsList: TIdEventNewNewsList read FOnNewNewsList write FOnNewNewsList;
  286. property OnXHDREntry : TIdEventXHDREntry read FOnXHDREntry write FOnXHDREntry;
  287. property OnXOVER : TIdEventXOVER read FOnXOVER write FOnXOVER;
  288. property OnTLSNotAvailable;
  289. property Port default IdPORT_NNTP;
  290. property Host;
  291. property UseTLS;
  292. end;
  293. EIdNNTPException = class(EIdException);
  294. EIdNNTPNoOnNewGroupsList = class(EIdNNTPException);
  295. EIdNNTPNoOnNewNewsList = class(EIdNNTPException);
  296. EIdNNTPNoOnNewsgroupList = class(EIdNNTPException);
  297. EIdNNTPNoOnXHDREntry = class(EIdNNTPException);
  298. EIdNNTPNoOnXOVER = class(EIdNNTPException);
  299. EIdNNTPStringListNotInitialized = class(EIdNNTPException);
  300. EIdNNTPConnectionRefused = class (EIdReplyRFCError);
  301. implementation
  302. uses
  303. IdComponent,
  304. IdGlobal,
  305. IdGlobalProtocols,
  306. IdResourceStringsProtocols,
  307. IdSSL,
  308. SysUtils;
  309. Procedure TIdNNTP.ParseXOVER(Aline : String; var AArticleIndex : Integer;
  310. var ASubject,
  311. AFrom : String;
  312. var ADate : TDateTime;
  313. var AMsgId,
  314. AReferences : String;
  315. var AByteCount,
  316. ALineCount : Integer;
  317. var AExtraData : String);
  318. begin
  319. {Strip backspace and tab junk sequences which occur after a tab separator so they don't throw off any code}
  320. ALine := StringReplace(ALine,#9#8#9,#9,[rfReplaceAll]);
  321. {Article Index}
  322. AArticleIndex := StrToCard ( Fetch( ALine, #9 ) );
  323. {Subject}
  324. ASubject := Fetch ( ALine, #9 );
  325. {From}
  326. AFrom := Fetch ( ALine, #9 );
  327. {Date}
  328. ADate := GMTToLocalDateTime ( Fetch ( Aline, #9 ) );
  329. {Message ID}
  330. AMsgId := Fetch ( Aline, #9 );
  331. {References}
  332. AReferences := Fetch( ALine, #9);
  333. {Byte Count}
  334. AByteCount := StrToCard(Fetch(ALine,#9));
  335. {Line Count}
  336. ALineCount := StrToCard(Fetch(ALine,#9));
  337. {Extra data}
  338. AExtraData := ALine;
  339. end;
  340. Procedure TIdNNTP.ParseNewsGroup(ALine : String; out ANewsGroup : String;
  341. out AHi, ALo : Integer;
  342. out AStatus : String);
  343. begin
  344. ANewsgroup := Fetch(ALine, ' ');
  345. AHi := StrToCard(Fetch(Aline, ' '));
  346. ALo := StrToCard(Fetch(ALine, ' '));
  347. AStatus := ALine;
  348. end;
  349. procedure TIdNNTP.InitComponent;
  350. begin
  351. inherited;
  352. Mode := mtReader;
  353. Port := IdPORT_NNTP;
  354. FRegularProtPort := IdPORT_NNTP;
  355. FImplicitTLSProtPort := IdPORT_SNEWS;
  356. end;
  357. function TIdNNTP.SendCmd(AOut: string; const AResponse: Array of SmallInt): SmallInt;
  358. begin
  359. // NOTE: Responses must be passed as arrays so that the proper inherited SendCmd is called
  360. // and a stack overflow is not caused.
  361. Result := inherited SendCmd(AOut, []);
  362. if (Result = 480) or (Result = 450) then begin
  363. // RLebeau - RFC 2980 says that if the password is not required,
  364. // then 281 will be returned for the username request, not 381.
  365. if (inherited SendCmd('AUTHINFO USER ' + Username, [281, 381]) = 381) then begin {do not localize}
  366. inherited SendCmd('AUTHINFO PASS ' + Password, 281); {do not localize}
  367. end;
  368. Result := inherited SendCmd(AOut, AResponse);
  369. end else begin
  370. CheckResponse(Result, AResponse);
  371. end;
  372. end;
  373. procedure TIdNNTP.Connect;
  374. begin
  375. inherited;
  376. AfterConnect;
  377. end;
  378. { This procedure gets the overview format as suported by the server }
  379. procedure TIdNNTP.GetOverviewFMT(AResponse: TIdStringList);
  380. begin
  381. SendCmd('LIST OVERVIEW.FMT', 215); {do not localize}
  382. IOHandler.Capture(AResponse);
  383. end;
  384. { Send the XOVER Command. XOVER [Range]
  385. Range can be of the form: Article Number i.e. 1
  386. Article Number followed by a dash
  387. Article Number followed by a dash and aother number
  388. Remember to select a group first and to issue a GetOverviewFMT so that you
  389. can interpret the information sent by the server corectly. }
  390. procedure TIdNNTP.XOVER(AParam: string; AResponse: TIdStrings);
  391. begin
  392. XOVERCommon(AParam);
  393. IOHandler.Capture(AResponse);
  394. end;
  395. procedure TIdNNTP.XOVER(AParam: string; AResponse: TStream);
  396. begin
  397. XOVERCommon(AParam);
  398. IOHandler.Capture(AResponse);
  399. end;
  400. { Send the XHDR Command. XHDR Header (Range | Message-ID)
  401. Range can be of the form: Article Number i.e. 1
  402. Article Number followed by a dash
  403. Article Number followed by a dash and aother number
  404. Parm is either the Range or the MessageID of the articles you want. They
  405. are Mutually Exclusive}
  406. procedure TIdNNTP.XHDR(AHeader: string; AParam: String; AResponse: TIdStrings);
  407. begin
  408. { This method will send the XHDR command.
  409. The programmer is responsible for choosing the correct header. Headers
  410. that should always work as per RFC 1036 are:
  411. From
  412. Date
  413. Newsgroups
  414. Subject
  415. Message-ID
  416. Path
  417. These Headers may work... They are optional per RFC1036 and new headers can
  418. be added at any time as server implementation changes
  419. Reply-To
  420. Sender
  421. Followup-To
  422. Expires
  423. References
  424. Control
  425. Distribution
  426. Organization
  427. Keywords
  428. Summary
  429. Approved
  430. Lines
  431. Xref
  432. }
  433. Self.XHDRCommon(AHeader,AParam);
  434. IOHandler.Capture(AResponse);
  435. end;
  436. procedure TIdNNTP.SelectGroup(AGroup: string);
  437. var
  438. s: string;
  439. begin
  440. SendCmd('Group ' + AGroup, [211]); {do not localize}
  441. s := LastCmdResult.Text[0];
  442. FlMsgCount := StrToCard(Fetch(s));
  443. FlMsgLow := StrToCard(Fetch(s));
  444. FlMsgHigh := StrToCard(Fetch(s));
  445. end;
  446. { This method will send messages via the IHAVE command.
  447. The IHAVE command first sends the message ID and waits for a response from the
  448. server prior to sending the header and body. This command is of no practical
  449. use for NNTP client readers as readers are generally denied the privelege
  450. to execute the IHAVE command. this is a news transport command. So use this
  451. when you are implementing a NNTP server send unit }
  452. procedure TIdNNTP.IHAVE(AMsg: TIdStringList);
  453. var
  454. i : Integer;
  455. MsgID : string;
  456. begin
  457. //TODO: Im not sure this fucntion works properly - needs checked
  458. // Why is it not using a TIdMessage?
  459. // Since we are merely forwarding messages we have already received
  460. // it is assumed that the required header fields and body are already in place
  461. // We need to get the message ID from the stringlist because it's required
  462. // that we send it s part of the IHAVE command
  463. for i := 0 to AMsg.Count - 1 do
  464. if IndyPos('Message-ID', AMsg.Strings[i]) > 0 then begin {do not localize}
  465. MsgID := AMsg.Strings[i];
  466. Fetch(MsgID,':');
  467. Break;
  468. end;
  469. SendCmd('IHAVE ' + MsgID, 335); {do not localize}
  470. WriteRFCStrings(AMsg);
  471. // Why is the response ignored? What is it?
  472. Readln;
  473. end;
  474. (*
  475. 1.1.1 The CHECK command
  476. CHECK <message-id>
  477. CHECK is used by a peer to discover if the article with the specified
  478. message-id should be sent to the server using the TAKETHIS command.
  479. The peer does not have to wait for a response from the server before
  480. sending the next command.
  481. From using the responses to the sequence of CHECK commands, a list of
  482. articles to be sent can be constructed for subsequent use by the
  483. TAKETHIS command.
  484. The use of the CHECK command for streaming is optional. Some
  485. implementations will directly use the TAKETHIS command and send all
  486. articles in the send queue on that peer for the server.
  487. On some implementations, the use of the CHECK command is not
  488. permitted when the server is in slave mode (via the SLAVE command).
  489. Responses that are of the form X3X must specify the message-id in the
  490. response.
  491. 1.1.2. Responses
  492. 238 no such article found, please send it to me
  493. 400 not accepting articles
  494. 431 try sending it again later
  495. 438 already have it, please don't send it to me
  496. 480 Transfer permission denied
  497. 500 Command not understood
  498. *)
  499. procedure TIdNNTP.Check(AMsgIDs: TIdStringList; var AResponses: TIdStringList);
  500. var
  501. i: Integer;
  502. begin
  503. if not Assigned(AResponses) then begin
  504. raise EIdNNTPStringListNotInitialized.Create(RSNNTPStringListNotInitialized);
  505. end;
  506. for i := 0 to AMsgIDs.Count - 1 do begin
  507. IOHandler.WriteLn('CHECK '+ AMsgIDs.Strings[i]); {do not localize}
  508. end;
  509. for i := 0 to AMsgIDs.Count - 1 do begin
  510. AResponses.Add(IOHandler.ReadLn)
  511. end;
  512. end;
  513. (*
  514. 1.3.1 The TAKETHIS command
  515. TAKETHIS <message-id>
  516. TAKETHIS is used to send articles to a server when in streaming mode.
  517. The entire article (header and body, in that sequence) is sent
  518. immediately after the peer sends the TAKETHIS command. The peer does
  519. not have to wait for a response from the server before sending the
  520. next command and the associated article.
  521. During transmission of the article, the peer should send the entire
  522. article, including header and body, in the manner specified for text
  523. transmission from the server. See RFC 977, Section 2.4.1 for
  524. details.
  525. Responses that are of the form X3X must specify the message-id in the
  526. response.
  527. 1.3.2. Responses
  528. 239 article transferred ok
  529. 400 not accepting articles
  530. 439 article transfer failed
  531. 480 Transfer permission denied
  532. 500 Command not understood
  533. *)
  534. function TIdNNTP.TakeThis(AMsgID: string; AMsg: TIdStreamVCL): string;
  535. // This message assumes AMsg is "raw" and has already taken care of . to ..
  536. begin
  537. SendCmd('TAKETHIS ' + AMsgID, 239); {do not localize}
  538. IOHandler.Write(AMsg);
  539. IOHandler.WriteLn('.');
  540. end;
  541. (*
  542. 3.10. The POST command
  543. 3.10.1. POST
  544. POST
  545. If posting is allowed, response code 340 is returned to indicate that
  546. the article to be posted should be sent. Response code 440 indicates
  547. that posting is prohibited for some installation-dependent reason.
  548. If posting is permitted, the article should be presented in the
  549. format specified by RFC850, and should include all required header
  550. lines. After the article's header and body have been completely sent
  551. by the client to the server, a further response code will be returned
  552. to indicate success or failure of the posting attempt.
  553. The text forming the header and body of the message to be posted
  554. should be sent by the client using the conventions for text received
  555. from the news server: A single period (".") on a line indicates the
  556. end of the text, with lines starting with a period in the original
  557. text having that period doubled during transmission.
  558. No attempt shall be made by the server to filter characters, fold or
  559. limit lines, or otherwise process incoming text. It is our intent
  560. that the server just pass the incoming message to be posted to the
  561. server installation's news posting software, which is separate from
  562. this specification. See RFC850 for more details.
  563. Since most installations will want the client news program to allow
  564. the user to prepare his message using some sort of text editor, and
  565. transmit it to the server for posting only after it is composed, the
  566. client program should take note of the herald message that greeted it
  567. when the connection was first established. This message indicates
  568. whether postings from that client are permitted or not, and can be
  569. used to caution the user that his access is read-only if that is the
  570. case. This will prevent the user from wasting a good deal of time
  571. composing a message only to find posting of the message was denied.
  572. The method and determination of which clients and hosts may post is
  573. installation dependent and is not covered by this specification.
  574. 3.10.2. Responses
  575. 240 article posted ok
  576. 340 send article to be posted. End with <CR-LF>.<CR-LF>
  577. 440 posting not allowed
  578. 441 posting failed
  579. (for reference, one of the following codes will be sent upon initial
  580. connection; the client program should determine whether posting is
  581. generally permitted from these:) 200 server ready - posting allowed
  582. 201 server ready - no posting allowed
  583. *)
  584. procedure TIdNNTP.Post(AMsg: TIdMessage);
  585. begin
  586. SendCmd('POST', 340); {do not localize}
  587. //Header
  588. if Length(NewsAgent) > 0 then begin
  589. AMsg.ExtraHeaders.Values['X-Newsreader'] := NewsAgent; {do not localize}
  590. end;
  591. SendMsg(AMsg);
  592. SendCmd('.', 240);
  593. end;
  594. procedure TIdNNTP.Post(AStream: TIdStreamVCL);
  595. begin
  596. SendCmd('POST', 340); {do not localize}
  597. IOHandler.Write(AStream);
  598. SendCmd('.', 240);
  599. end;
  600. procedure TIdNNTP.ProcessGroupList(ACmd: string; AResponse: integer;
  601. ALisTIdEvent: TIdEvenTIdNewsgroupList);
  602. var
  603. s1, sNewsgroup: string;
  604. lLo, lHi: Integer;
  605. sStatus: string;
  606. LCanContinue: Boolean;
  607. begin
  608. BeginWork(wmRead, 0); try
  609. SendCmd(ACmd, AResponse);
  610. s1 := IOHandler.ReadLn;
  611. LCanContinue := True;
  612. while (s1 <> '.') and LCanContinue do
  613. begin
  614. ParseNewsGroup(s1, sNewsgroup, lHi, lLo, sStatus);
  615. ALisTIdEvent(sNewsgroup, lLo, lHi, sStatus, LCanContinue);
  616. s1 := IOHandler.ReadLn;
  617. end;
  618. finally
  619. EndWork(wmRead);
  620. end;
  621. end;
  622. procedure TIdNNTP.GetNewsgroupList;
  623. begin
  624. if not Assigned(FOnNewsgroupList) then begin
  625. raise EIdNNTPNoOnNewsgroupList.Create(RSNNTPNoOnNewsgroupList);
  626. end;
  627. ProcessGroupList('LIST', 215, FOnNewsgroupList); {do not localize}
  628. end;
  629. procedure TIdNNTP.GetNewGroupsList(ADate: TDateTime; AGMT: boolean;
  630. ADistributions: string);
  631. begin
  632. if not Assigned(FOnNewGroupsList) then begin
  633. raise EIdNNTPNoOnNewGroupsList.Create(RSNNTPNoOnNewGroupsList);
  634. end;
  635. ProcessGroupList('NEWGROUPS ' + ConvertDateTimeDist(ADate, AGMT, ADistributions), {do not localize}
  636. 231, FOnNewGroupsList);
  637. end;
  638. procedure TIdNNTP.GetNewNewsList(ANewsgroups: string;
  639. ADate: TDateTime; AGMT: boolean; ADistributions: string);
  640. var
  641. s1: string;
  642. CanContinue: Boolean;
  643. begin
  644. if not Assigned(FOnNewNewsList) then begin
  645. raise EIdNNTPNoOnNewNewsList.Create(RSNNTPNoOnNewNewsList);
  646. end;
  647. BeginWork(wmRead,0); try
  648. SendCmd('NEWNEWS ' + ANewsgroups + ' ' + ConvertDateTimeDist(ADate, AGMT, ADistributions), 230); {do not localize}
  649. s1 := IOHandler.ReadLn;
  650. CanContinue := True;
  651. while (s1 <> '.') and CanContinue do begin
  652. FOnNewNewsList(s1, CanContinue);
  653. s1 := IOHandler.ReadLn;
  654. end;
  655. finally
  656. EndWork(wmRead);
  657. end;
  658. end;
  659. (*
  660. 3.9. The NEXT command
  661. 3.9.1. NEXT
  662. NEXT
  663. The internally maintained "current article pointer" is advanced to
  664. the next article in the current newsgroup. If no more articles
  665. remain in the current group, an error message is returned and the
  666. current article remains selected.
  667. The internally-maintained "current article pointer" is set by this
  668. command.
  669. A response indicating the current article number, and the message-id
  670. string will be returned. No text is sent in response to this
  671. command.
  672. 3.9.2. Responses
  673. 223 n a article retrieved - request text separately
  674. (n = article number, a = unique article id)
  675. 412 no newsgroup selected
  676. 420 no current article has been selected
  677. 421 no next article in this group
  678. *)
  679. function TIdNNTP.Next: Boolean;
  680. begin
  681. Result := SendCmd('NEXT', [223, 421]) = 223; {do not localize}
  682. end;
  683. (*
  684. 3.5. The LAST command
  685. 3.5.1. LAST
  686. LAST
  687. The internally maintained "current article pointer" is set to the
  688. previous article in the current newsgroup. If already positioned at
  689. the first article of the newsgroup, an error message is returned and
  690. the current article remains selected.
  691. The internally-maintained "current article pointer" is set by this
  692. command.
  693. A response indicating the current article number, and a message-id
  694. string will be returned. No text is sent in response to this
  695. command.
  696. 3.5.2. Responses
  697. 223 n a article retrieved - request text separately
  698. (n = article number, a = unique article id)
  699. 412 no newsgroup selected
  700. 420 no current article has been selected
  701. 422 no previous article in this group
  702. *)
  703. function TIdNNTP.Previous: Boolean;
  704. begin
  705. Result := SendCmd('LAST', [223, 422]) = 223; {do not localize}
  706. end;
  707. function TIdNNTP.SelectArticle(AMsgNo: Integer): Boolean;
  708. begin
  709. Result := SendCmd('STAT ' + IntToStr(AMsgNo), [223, 423]) = 223; {do not localize}
  710. end;
  711. procedure TIdNNTP.GetNewsgroupList(AList: TIdStrings);
  712. begin
  713. SendCmd('LIST', 215); {do not localize}
  714. IOHandler.Capture(AList);
  715. end;
  716. procedure TIdNNTP.GetNewGroupsList(ADate: TDateTime; AGMT: boolean;
  717. ADistributions: string; AList: TIdStrings);
  718. begin
  719. SendCmd('NEWGROUPS ' + ConvertDateTimeDist(ADate, AGMT, ADistributions), 231); {do not localize}
  720. IOHandler.Capture(AList);
  721. end;
  722. procedure TIdNNTP.GetNewNewsList(ANewsgroups: string; ADate: TDateTime;
  723. AGMT: boolean; ADistributions: string; AList: TIdStrings);
  724. begin
  725. SendCmd('NEWNEWS ' + ANewsgroups + ' ' + ConvertDateTimeDist(ADate, AGMT, ADistributions), 230); {do not localize}
  726. IOHandler.Capture(AList);
  727. end;
  728. function TIdNNTP.ConvertDateTimeDist(ADate: TDateTime; AGMT: boolean;
  729. ADistributions: string): string;
  730. begin
  731. Result := FormatDateTime('yymmdd hhnnss', ADate); {do not localize}
  732. if AGMT then begin
  733. Result:= Result + ' GMT'; {do not localize}
  734. end;
  735. if Length(ADistributions) > 0 then begin
  736. Result := ' <' + ADistributions + '>';
  737. end;
  738. end;
  739. (*
  740. 3.1. The ARTICLE, BODY, HEAD, and STAT commands
  741. There are two forms to the ARTICLE command (and the related BODY,
  742. HEAD, and STAT commands), each using a different method of specifying
  743. which article is to be retrieved. When the ARTICLE command is
  744. followed by a message-id in angle brackets ("<" and ">"), the first
  745. form of the command is used; when a numeric parameter or no parameter
  746. is supplied, the second form is invoked.
  747. The text of the article is returned as a textual response, as
  748. described earlier in this document.
  749. The HEAD and BODY commands are identical to the ARTICLE command
  750. except that they respectively return only the header lines or text
  751. body of the article.
  752. The STAT command is similar to the ARTICLE command except that no
  753. text is returned. When selecting by message number within a group,
  754. the STAT command serves to set the current article pointer without
  755. sending text. The returned acknowledgement response will contain the
  756. message-id, which may be of some value. Using the STAT command to
  757. select by message-id is valid but of questionable value, since a
  758. selection by message-id does NOT alter the "current article pointer".
  759. 3.1.1. ARTICLE (selection by message-id)
  760. ARTICLE <message-id>
  761. Display the header, a blank line, then the body (text) of the
  762. specified article. Message-id is the message id of an article as
  763. shown in that article's header. It is anticipated that the client
  764. will obtain the message-id from a list provided by the NEWNEWS
  765. command, from references contained within another article, or from
  766. the message-id provided in the response to some other commands.
  767. Please note that the internally-maintained "current article pointer"
  768. is NOT ALTERED by this command. This is both to facilitate the
  769. presentation of articles that may be referenced within an article
  770. being read, and because of the semantic difficulties of determining
  771. the proper sequence and membership of an article which may have been
  772. posted to more than one newsgroup.
  773. 3.1.2. ARTICLE (selection by number)
  774. ARTICLE [nnn]
  775. Displays the header, a blank line, then the body (text) of the
  776. current or specified article. The optional parameter nnn is the
  777. numeric id of an article in the current newsgroup and must be chosen
  778. from the range of articles provided when the newsgroup was selected.
  779. If it is omitted, the current article is assumed.
  780. The internally-maintained "current article pointer" is set by this
  781. command if a valid article number is specified.
  782. [the following applies to both forms of the article command.] A
  783. response indicating the current article number, a message-id string,
  784. and that text is to follow will be returned.
  785. The message-id string returned is an identification string contained
  786. within angle brackets ("<" and ">"), which is derived from the header
  787. of the article itself. The Message-ID header line (required by
  788. RFC850) from the article must be used to supply this information. If
  789. the message-id header line is missing from the article, a single
  790. digit "0" (zero) should be supplied within the angle brackets.
  791. Since the message-id field is unique with each article, it may be
  792. used by a news reading program to skip duplicate displays of articles
  793. that have been posted more than once, or to more than one newsgroup.
  794. 3.1.3. Responses
  795. 220 n <a> article retrieved - head and body follow
  796. (n = article number, <a> = message-id)
  797. 221 n <a> article retrieved - head follows
  798. 222 n <a> article retrieved - body follows
  799. 223 n <a> article retrieved - request text separately
  800. 412 no newsgroup has been selected
  801. 420 no current article has been selected
  802. 423 no such article number in this group
  803. 430 no such article found
  804. *)
  805. function TIdNNTP.GetArticle(AMsg: TIdMessage): Boolean;
  806. begin
  807. Result := True;
  808. SendCmd('ARTICLE', 220); {do not localize}
  809. AMsg.Clear;
  810. //Don't call ReceiveBody if the message ended at the end of the headers
  811. //(ReceiveHeader() would have returned '.' in that case)...
  812. if ReceiveHeader(AMsg) = '' then begin
  813. ReceiveBody(AMsg);
  814. end;
  815. end;
  816. function TIdNNTP.GetArticle(AMsgNo: Integer; AMsg: TIdMessage): Boolean;
  817. begin
  818. Result := SendCmd('ARTICLE ' + IntToStr(AMsgNo), [220, 423]) = 220; {do not localize}
  819. if Result then begin
  820. AMsg.Clear;
  821. //Don't call ReceiveBody if the message ended at the end of the headers
  822. //(ReceiveHeader() would have returned '.' in that case)...
  823. if ReceiveHeader(AMsg) = '' then begin
  824. ReceiveBody(AMsg);
  825. end;
  826. end;
  827. end;
  828. function TIdNNTP.GetArticle(AMsgID: string; AMsg: TIdMessage): Boolean;
  829. begin
  830. Result := SendCmd('ARTICLE ' + EnsureMsgIDBrackets(AMsgID), [220, 430]) = 220; {do not localize}
  831. if Result then begin
  832. AMsg.Clear;
  833. //Don't call ReceiveBody if the message ended at the end of the headers
  834. //(ReceiveHeader() would have returned '.' in that case)...
  835. if ReceiveHeader(AMsg) = '' then begin
  836. ReceiveBody(AMsg);
  837. end;
  838. end;
  839. end;
  840. function TIdNNTP.GetArticle(AMsg: TIdStrings): Boolean;
  841. begin
  842. Result := True;
  843. SendCmd('ARTICLE', 220); {do not localize}
  844. AMsg.Clear;
  845. IOHandler.Capture(AMsg);
  846. end;
  847. function TIdNNTP.GetArticle(AMsgNo: Integer; AMsg: TIdStrings): Boolean;
  848. begin
  849. Result := SendCmd('ARTICLE ' + IntToStr(AMsgNo), [220, 423]) = 220; {do not localize}
  850. if Result then begin
  851. AMsg.Clear;
  852. IOHandler.Capture(AMsg);
  853. end;
  854. end;
  855. function TIdNNTP.GetArticle(AMsgID: string; AMsg: TIdStrings): Boolean;
  856. begin
  857. Result := SendCmd('ARTICLE ' + EnsureMsgIDBrackets(AMsgID), [220, 430]) = 220; {do not localize}
  858. if Result then begin
  859. AMsg.Clear;
  860. IOHandler.Capture(AMsg);
  861. end;
  862. end;
  863. function TIdNNTP.GetArticle(AMsg: TStream): Boolean;
  864. begin
  865. Result := True;
  866. SendCmd('ARTICLE', 220); {do not localize}
  867. IOHandler.Capture(AMsg);
  868. end;
  869. function TIdNNTP.GetArticle(AMsgNo: Integer; AMsg: TStream): Boolean;
  870. begin
  871. Result := SendCmd('ARTICLE ' + IntToStr(AMsgNo), [220, 423]) = 220; {do not localize}
  872. if Result then begin
  873. IOHandler.Capture(AMsg);
  874. end;
  875. end;
  876. function TIdNNTP.GetArticle(AMsgID: string; AMsg: TStream): Boolean;
  877. begin
  878. Result := SendCmd('ARTICLE ' + EnsureMsgIDBrackets(AMsgID), [220, 430]) = 220; {do not localize}
  879. if Result then begin
  880. IOHandler.Capture(AMsg);
  881. end;
  882. end;
  883. function TIdNNTP.GetBody(AMsg: TIdMessage): Boolean;
  884. begin
  885. Result := True;
  886. if Result then begin
  887. SendCmd('BODY', 222); {do not localize}
  888. AMsg.Clear;
  889. ReceiveBody(AMsg);
  890. end;
  891. end;
  892. function TIdNNTP.GetBody(AMsgNo: Integer; AMsg: TIdMessage): Boolean;
  893. begin
  894. Result := SendCmd('BODY ' + IntToStr(AMsgNo), [222, 423]) = 222; {do not localize}
  895. if Result then begin
  896. AMsg.Clear;
  897. ReceiveBody(AMsg);
  898. end;
  899. end;
  900. function TIdNNTP.GetBody(AMsgID: string; AMsg: TIdMessage): Boolean;
  901. begin
  902. Result := SendCmd('BODY ' + EnsureMsgIDBrackets(AMsgID), [222, 430]) = 222; {do not localize}
  903. if Result then begin
  904. AMsg.Clear;
  905. ReceiveBody(AMsg);
  906. end;
  907. end;
  908. function TIdNNTP.GetBody(AMsg: TIdStrings): Boolean;
  909. begin
  910. Result := True;
  911. SendCmd('BODY', 222); {do not localize}
  912. AMsg.Clear;
  913. IOHandler.Capture(AMsg);
  914. end;
  915. function TIdNNTP.GetBody(AMsgNo: Integer; AMsg: TIdStrings): Boolean;
  916. begin
  917. Result := SendCmd('BODY ' + IntToStr(AMsgNo), [222, 423]) = 222; {do not localize}
  918. if Result then begin
  919. AMsg.Clear;
  920. IOHandler.Capture(AMsg);
  921. end;
  922. end;
  923. function TIdNNTP.GetBody(AMsgID: string; AMsg: TIdStrings): Boolean;
  924. begin
  925. Result := SendCmd('BODY ' + EnsureMsgIDBrackets(AMsgID), [222, 430]) = 222; {do not localize}
  926. if Result then begin
  927. AMsg.Clear;
  928. IOHandler.Capture(AMsg);
  929. end;
  930. end;
  931. function TIdNNTP.GetBody(AMsg: TStream): Boolean;
  932. begin
  933. Result := True;
  934. SendCmd('BODY', 222); {do not localize}
  935. IOHandler.Capture(AMsg);
  936. end;
  937. function TIdNNTP.GetBody(AMsgNo: Integer; AMsg: TStream): Boolean;
  938. begin
  939. Result := SendCmd('BODY ' + IntToStr(AMsgNo), [222, 423]) = 222; {do not localize}
  940. if Result then begin
  941. IOHandler.Capture(AMsg);
  942. end;
  943. end;
  944. function TIdNNTP.GetBody(AMsgID: string; AMsg: TStream): Boolean;
  945. begin
  946. Result := SendCmd('BODY ' + EnsureMsgIDBrackets(AMsgID), [222, 430]) = 222; {do not localize}
  947. if Result then begin
  948. IOHandler.Capture(AMsg);
  949. end;
  950. end;
  951. function TIdNNTP.GetHeader(AMsg: TIdMessage): Boolean;
  952. begin
  953. Result := True;
  954. SendCmd('HEAD', 221); {do not localize}
  955. AMsg.Clear;
  956. ReceiveHeader(AMsg);
  957. end;
  958. function TIdNNTP.GetHeader(AMsgNo: Integer; AMsg: TIdMessage): Boolean;
  959. begin
  960. Result := SendCmd('HEAD ' + IntToStr(AMsgNo), [221, 423]) = 221; {do not localize}
  961. if Result then begin
  962. AMsg.Clear;
  963. ReceiveHeader(AMsg);
  964. end;
  965. end;
  966. function TIdNNTP.GetHeader(AMsgID: string; AMsg: TIdMessage): Boolean;
  967. begin
  968. Result := SendCmd('HEAD ' + EnsureMsgIDBrackets(AMsgID), [221, 430]) = 221; {do not localize}
  969. if Result then begin
  970. AMsg.Clear;
  971. ReceiveHeader(AMsg);
  972. end;
  973. end;
  974. function TIdNNTP.GetHeader(AMsg: TIdStrings): Boolean;
  975. begin
  976. Result := True;
  977. SendCmd('HEAD', 221); {do not localize}
  978. AMsg.Clear;
  979. IOHandler.Capture(AMsg);
  980. end;
  981. function TIdNNTP.GetHeader(AMsgNo: Integer; AMsg: TIdStrings): Boolean;
  982. begin
  983. Result := SendCmd('HEAD ' + IntToStr(AMsgNo), [221, 423]) = 221; {do not localize}
  984. if Result then begin
  985. AMsg.Clear;
  986. IOHandler.Capture(AMsg);
  987. end;
  988. end;
  989. function TIdNNTP.GetHeader(AMsgID: string; AMsg: TIdStrings): Boolean;
  990. begin
  991. Result := SendCmd('HEAD ' + EnsureMsgIDBrackets(AMsgID), [221, 430]) = 221; {do not localize}
  992. if Result then begin
  993. AMsg.Clear;
  994. IOHandler.Capture(AMsg);
  995. end;
  996. end;
  997. function TIdNNTP.GetHeader(AMsg: TStream): Boolean;
  998. begin
  999. Result := True;
  1000. SendCmd('HEAD', 221); {do not localize}
  1001. IOHandler.Capture(AMsg);
  1002. end;
  1003. function TIdNNTP.GetHeader(AMsgNo: Integer; AMsg: TStream): Boolean;
  1004. begin
  1005. Result := SendCmd('HEAD ' + IntToStr(AMsgNo), [221, 423]) = 221; {do not localize}
  1006. if Result then begin
  1007. IOHandler.Capture(AMsg);
  1008. end;
  1009. end;
  1010. function TIdNNTP.GetHeader(AMsgID: string; AMsg: TStream): Boolean;
  1011. begin
  1012. Result := SendCmd('HEAD ' + EnsureMsgIDBrackets(AMsgID), [221, 430]) = 221; {do not localize}
  1013. if Result then begin
  1014. IOHandler.Capture(AMsg);
  1015. end;
  1016. end;
  1017. procedure TIdNNTP.GetNewsgroupList(AStream: TStream);
  1018. begin
  1019. SendCmd('LIST', 215); {do not localize}
  1020. IOHandler.Capture(AStream);
  1021. end;
  1022. procedure TIdNNTP.AfterConnect;
  1023. begin
  1024. try
  1025. GetResponse([]);
  1026. // Here lets check to see what condition we are in after being greeted by
  1027. // the server. The application utilizing NNTPWinshoe should check the value
  1028. // of GreetingResult to determine if further action is warranted.
  1029. case LastCmdResult.NumericCode of
  1030. 200: FPermission := crCanPost;
  1031. 201: FPermission := crNoPost;
  1032. 400: FPermission := crTempUnavailable;
  1033. // This should never happen because the server should immediately close
  1034. // the connection but just in case ....
  1035. // Kudzu: Changed this to an exception, otherwise it produces non-standard usage by the
  1036. // users code
  1037. 502: raise EIdNNTPConnectionRefused.CreateError(502, RSNNTPConnectionRefused);
  1038. end;
  1039. // here we call SeTIdMode on the value stored in mode to make sure we can
  1040. // use the mode we have selected
  1041. case Mode of
  1042. mtStream: begin
  1043. SendCmd('MODE STREAM'); {do not localize}
  1044. if LastCmdResult.NumericCode <> 203 then begin
  1045. ModeResult := mrNoStream
  1046. end else begin
  1047. ModeResult := mrCanStream;
  1048. end;
  1049. end;
  1050. mtReader: begin
  1051. // We should get the same info we got in the greeting
  1052. // result but we set mode to reader anyway since the
  1053. // server may want to do some internal reconfiguration
  1054. // if it knows that a reader has connected
  1055. SendCmd('MODE READER'); {do not localize}
  1056. if LastCmdResult.NumericCode <> 200 then begin
  1057. ModeResult := mrNoPost;
  1058. end else begin
  1059. ModeResult := mrCanPost;
  1060. end;
  1061. end;
  1062. end;
  1063. GetCapability;
  1064. StartTLS;
  1065. except
  1066. Disconnect;
  1067. Raise;
  1068. end;
  1069. end;
  1070. destructor TIdNNTP.Destroy;
  1071. begin
  1072. inherited;
  1073. end;
  1074. procedure TIdNNTP.GetCapability;
  1075. var
  1076. i: Integer;
  1077. s: String;
  1078. begin
  1079. FCapabilities.Clear;
  1080. if SendCmd('LIST EXTENSIONS') in [202, 215] then {do not localize}
  1081. begin
  1082. IOHandler.Capture(FCapabilities,'.');
  1083. end;
  1084. //flatten everything out for easy processing
  1085. for i := 0 to FCapabilities.Count -1 do
  1086. begin
  1087. s := Trim(UpperCase(FCapabilities[i]));
  1088. FCapabilities[i] := s;
  1089. end;
  1090. FOVERSupported := IsExtCmdSupported('OVER'); {do not localize}
  1091. FHDRSupported := IsExtCmdSupported('HDR'); {do not localize}
  1092. // Self.FStartTLSSupported := IsExtCmdSupported('STARTTLS');
  1093. end;
  1094. function TIdNNTP.IsExtCmdSupported(AExtension: String): Boolean;
  1095. begin
  1096. Result := FCapabilities.IndexOf(Trim(UpperCase(AExtension)))>-1;
  1097. end;
  1098. procedure TIdNNTP.StartTLS;
  1099. var LIO : TIdSSLIOHandlerSocketBase;
  1100. begin
  1101. if (IOHandler is TIdSSLIOHandlerSocketBase) and (FUseTLS<>utNoTLSSupport) then
  1102. begin
  1103. LIO := TIdSSLIOHandlerSocketBase(IOHandler);
  1104. //we check passthrough because we can either be using TLS currently with
  1105. //implicit TLS support or because STARTLS was issued previously.
  1106. if LIO.PassThrough then
  1107. begin
  1108. if Self.IsExtCmdSupported('STARTTLS') then {do not localize}
  1109. begin
  1110. if SendCmd('STARTTLS')=382 then {do not localize}
  1111. begin
  1112. Self.TLSHandshake;
  1113. AfterConnect;
  1114. end
  1115. else
  1116. begin
  1117. ProcessTLSNegCmdFailed;
  1118. end;
  1119. end
  1120. else
  1121. begin
  1122. ProcessTLSNotAvail;
  1123. end;
  1124. end;
  1125. end;
  1126. end;
  1127. function TIdNNTP.GetSupportsTLS: boolean;
  1128. begin
  1129. Result := IsExtCmdSupported('STARTTLS') {do not localize}
  1130. end;
  1131. procedure TIdNNTP.XHDR(AHeader, AParam: string);
  1132. var LLine : String;
  1133. LMsg, LHeaderData : String;
  1134. LCanContinue : Boolean;
  1135. begin
  1136. if Assigned(FOnXHDREntry) then
  1137. begin
  1138. XHDRCommon(AHeader,AParam);
  1139. BeginWork(wmRead, 0);
  1140. try
  1141. LLine := IOHandler.ReadLn;
  1142. LCanContinue := True;
  1143. while (LLine <> '.') and LCanContinue do
  1144. begin
  1145. ParseXHDRLine(LLine,LMsg,LHeaderData);
  1146. FOnXHDREntry(AHeader,LMsg,LHeaderData,LCanContinue);
  1147. LLine := IOHandler.ReadLn;
  1148. end;
  1149. finally
  1150. EndWork(wmRead);
  1151. end;
  1152. end
  1153. else
  1154. begin
  1155. raise EIdNNTPNoOnXHDREntry.Create(RSNNTPNoOnXHDREntry);
  1156. end;
  1157. end;
  1158. procedure TIdNNTP.XOVER(AParam: string);
  1159. var
  1160. LLine : String;
  1161. //for our XOVER data
  1162. LArticleIndex : Integer;
  1163. LSubject,
  1164. LFrom : String;
  1165. LDate : TDateTime;
  1166. LMsgId, LReferences : String;
  1167. LByteCount,
  1168. LLineCount : Integer;
  1169. LExtraData : String;
  1170. LCanContinue : Boolean;
  1171. begin
  1172. if Assigned( FOnXOVER) then
  1173. begin
  1174. XOVERCommon(AParam);
  1175. BeginWork(wmRead, 0);
  1176. try
  1177. LLine := IOHandler.ReadLn;
  1178. LCanContinue := True;
  1179. while (LLine <> '.') and LCanContinue do
  1180. begin
  1181. ParseXOVER(LLine,LArticleIndex,LSubject,LFrom,LDate,
  1182. LMsgId,LReferences,LByteCount,LLineCount,LExtraData);
  1183. FOnXOVER(LArticleIndex,LSubject,LFrom,LDate,LMsgId,LReferences,LByteCount,LLineCount,LExtraData,LCanContinue);
  1184. LLine := IOHandler.ReadLn;
  1185. end;
  1186. finally
  1187. EndWork(wmRead);
  1188. end;
  1189. end
  1190. else
  1191. begin
  1192. raise EIdNNTPNoOnXOVER.Create(RSNNTPNoOnXOVER);
  1193. end;
  1194. end;
  1195. procedure TIdNNTP.ParseXHDRLine(ALine: String; out AMsg,
  1196. AHeaderData: String);
  1197. begin
  1198. //from: RFC 2890
  1199. //Each line
  1200. //containing matched headers returned by the server has an article
  1201. //number (or message ID, if a message ID was specified in the command),
  1202. //then one or more spaces, then the value of the requested header in
  1203. //that article.
  1204. //from: http://www.ietf.org/internet-drafts/draft-ietf-nntpext-base-18.txt
  1205. // describing HDR
  1206. // The line consists
  1207. // of the article number, a space, and then the contents of the header
  1208. // (without the header name or the colon and space that follow it) or
  1209. // metadata item. If the article is specified by message-id rather than
  1210. // by article range, the article number is given as "0".
  1211. AMsg := Fetch(ALine);
  1212. AHeaderData := ALine;
  1213. end;
  1214. procedure TIdNNTP.XHDRCommon(AHeader, AParam : String);
  1215. begin
  1216. if FHDRSupported then
  1217. begin
  1218. //http://www.ietf.org/internet-drafts/draft-ietf-nntpext-base-18.txt
  1219. //says the correct reply code is 225 but RFC 2980 specifies 221 for the
  1220. //XHDR command so we should accept both to CYA.
  1221. SendCmd('HDR '+ AHeader + ' ' + AParam, [225, 221]); {do not localize}
  1222. end
  1223. else
  1224. begin
  1225. SendCmd('XHDR ' + AHeader + ' ' + AParam, 221); {do not localize}
  1226. end;
  1227. end;
  1228. procedure TIdNNTP.XOVERCommon(AParam: String);
  1229. begin
  1230. if FOVERSupported then begin
  1231. SendCmd('OVER '+ AParam, 224); {do not localize}
  1232. end else begin
  1233. SendCmd('XOVER ' + AParam, 224); {do not localize}
  1234. end;
  1235. end;
  1236. procedure TIdNNTP.DisconnectNotifyPeer;
  1237. begin
  1238. inherited;
  1239. SendCmd('Quit', 205); {do not localize}
  1240. end;
  1241. end.