IdNNTP.pas 54 KB

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