IdNNTPServer.pas 111 KB

12345678910111213141516171819202122232425262728293031323334353637383940414243444546474849505152535455565758596061626364656667686970717273747576777879808182838485868788899091929394959697989910010110210310410510610710810911011111211311411511611711811912012112212312412512612712812913013113213313413513613713813914014114214314414514614714814915015115215315415515615715815916016116216316416516616716816917017117217317417517617717817918018118218318418518618718818919019119219319419519619719819920020120220320420520620720820921021121221321421521621721821922022122222322422522622722822923023123223323423523623723823924024124224324424524624724824925025125225325425525625725825926026126226326426526626726826927027127227327427527627727827928028128228328428528628728828929029129229329429529629729829930030130230330430530630730830931031131231331431531631731831932032132232332432532632732832933033133233333433533633733833934034134234334434534634734834935035135235335435535635735835936036136236336436536636736836937037137237337437537637737837938038138238338438538638738838939039139239339439539639739839940040140240340440540640740840941041141241341441541641741841942042142242342442542642742842943043143243343443543643743843944044144244344444544644744844945045145245345445545645745845946046146246346446546646746846947047147247347447547647747847948048148248348448548648748848949049149249349449549649749849950050150250350450550650750850951051151251351451551651751851952052152252352452552652752852953053153253353453553653753853954054154254354454554654754854955055155255355455555655755855956056156256356456556656756856957057157257357457557657757857958058158258358458558658758858959059159259359459559659759859960060160260360460560660760860961061161261361461561661761861962062162262362462562662762862963063163263363463563663763863964064164264364464564664764864965065165265365465565665765865966066166266366466566666766866967067167267367467567667767867968068168268368468568668768868969069169269369469569669769869970070170270370470570670770870971071171271371471571671771871972072172272372472572672772872973073173273373473573673773873974074174274374474574674774874975075175275375475575675775875976076176276376476576676776876977077177277377477577677777877978078178278378478578678778878979079179279379479579679779879980080180280380480580680780880981081181281381481581681781881982082182282382482582682782882983083183283383483583683783883984084184284384484584684784884985085185285385485585685785885986086186286386486586686786886987087187287387487587687787887988088188288388488588688788888989089189289389489589689789889990090190290390490590690790890991091191291391491591691791891992092192292392492592692792892993093193293393493593693793893994094194294394494594694794894995095195295395495595695795895996096196296396496596696796896997097197297397497597697797897998098198298398498598698798898999099199299399499599699799899910001001100210031004100510061007100810091010101110121013101410151016101710181019102010211022102310241025102610271028102910301031103210331034103510361037103810391040104110421043104410451046104710481049105010511052105310541055105610571058105910601061106210631064106510661067106810691070107110721073107410751076107710781079108010811082108310841085108610871088108910901091109210931094109510961097109810991100110111021103110411051106110711081109111011111112111311141115111611171118111911201121112211231124112511261127112811291130113111321133113411351136113711381139114011411142114311441145114611471148114911501151115211531154115511561157115811591160116111621163116411651166116711681169117011711172117311741175117611771178117911801181118211831184118511861187118811891190119111921193119411951196119711981199120012011202120312041205120612071208120912101211121212131214121512161217121812191220122112221223122412251226122712281229123012311232123312341235123612371238123912401241124212431244124512461247124812491250125112521253125412551256125712581259126012611262126312641265126612671268126912701271127212731274127512761277127812791280128112821283128412851286128712881289129012911292129312941295129612971298129913001301130213031304130513061307130813091310131113121313131413151316131713181319132013211322132313241325132613271328132913301331133213331334133513361337133813391340134113421343134413451346134713481349135013511352135313541355135613571358135913601361136213631364136513661367136813691370137113721373137413751376137713781379138013811382138313841385138613871388138913901391139213931394139513961397139813991400140114021403140414051406140714081409141014111412141314141415141614171418141914201421142214231424142514261427142814291430143114321433143414351436143714381439144014411442144314441445144614471448144914501451145214531454145514561457145814591460146114621463146414651466146714681469147014711472147314741475147614771478147914801481148214831484148514861487148814891490149114921493149414951496149714981499150015011502150315041505150615071508150915101511151215131514151515161517151815191520152115221523152415251526152715281529153015311532153315341535153615371538153915401541154215431544154515461547154815491550155115521553155415551556155715581559156015611562156315641565156615671568156915701571157215731574157515761577157815791580158115821583158415851586158715881589159015911592159315941595159615971598159916001601160216031604160516061607160816091610161116121613161416151616161716181619162016211622162316241625162616271628162916301631163216331634163516361637163816391640164116421643164416451646164716481649165016511652165316541655165616571658165916601661166216631664166516661667166816691670167116721673167416751676167716781679168016811682168316841685168616871688168916901691169216931694169516961697169816991700170117021703170417051706170717081709171017111712171317141715171617171718171917201721172217231724172517261727172817291730173117321733173417351736173717381739174017411742174317441745174617471748174917501751175217531754175517561757175817591760176117621763176417651766176717681769177017711772177317741775177617771778177917801781178217831784178517861787178817891790179117921793179417951796179717981799180018011802180318041805180618071808180918101811181218131814181518161817181818191820182118221823182418251826182718281829183018311832183318341835183618371838183918401841184218431844184518461847184818491850185118521853185418551856185718581859186018611862186318641865186618671868186918701871187218731874187518761877187818791880188118821883188418851886188718881889189018911892189318941895189618971898189919001901190219031904190519061907190819091910191119121913191419151916191719181919192019211922192319241925192619271928192919301931193219331934193519361937193819391940194119421943194419451946194719481949195019511952195319541955195619571958195919601961196219631964196519661967196819691970197119721973197419751976197719781979198019811982198319841985198619871988198919901991199219931994199519961997199819992000200120022003200420052006200720082009201020112012201320142015201620172018201920202021202220232024202520262027202820292030203120322033203420352036203720382039204020412042204320442045204620472048204920502051205220532054205520562057205820592060206120622063206420652066206720682069207020712072207320742075207620772078207920802081208220832084208520862087208820892090209120922093209420952096209720982099210021012102210321042105210621072108210921102111211221132114211521162117211821192120212121222123212421252126212721282129213021312132213321342135213621372138213921402141214221432144214521462147214821492150215121522153215421552156215721582159216021612162216321642165216621672168216921702171217221732174217521762177217821792180218121822183218421852186218721882189219021912192219321942195219621972198219922002201220222032204220522062207220822092210221122122213221422152216221722182219222022212222222322242225222622272228222922302231223222332234223522362237223822392240224122422243224422452246224722482249225022512252225322542255225622572258225922602261226222632264226522662267226822692270227122722273227422752276227722782279228022812282228322842285228622872288228922902291229222932294229522962297229822992300230123022303230423052306230723082309231023112312231323142315231623172318231923202321232223232324232523262327232823292330233123322333233423352336233723382339234023412342234323442345234623472348234923502351235223532354235523562357235823592360236123622363236423652366236723682369237023712372237323742375237623772378237923802381238223832384238523862387238823892390239123922393239423952396239723982399240024012402240324042405240624072408240924102411241224132414241524162417241824192420242124222423242424252426242724282429243024312432243324342435243624372438243924402441244224432444244524462447244824492450245124522453245424552456245724582459246024612462246324642465246624672468246924702471247224732474247524762477247824792480248124822483248424852486248724882489249024912492249324942495249624972498249925002501250225032504250525062507250825092510251125122513251425152516251725182519252025212522252325242525252625272528252925302531253225332534253525362537253825392540254125422543254425452546254725482549255025512552255325542555255625572558255925602561256225632564256525662567256825692570257125722573257425752576257725782579258025812582258325842585258625872588258925902591259225932594259525962597259825992600260126022603260426052606260726082609261026112612261326142615261626172618261926202621262226232624262526262627262826292630263126322633263426352636263726382639264026412642264326442645264626472648264926502651265226532654265526562657265826592660266126622663266426652666266726682669267026712672267326742675267626772678267926802681268226832684268526862687268826892690269126922693269426952696269726982699270027012702270327042705270627072708270927102711271227132714271527162717271827192720272127222723272427252726272727282729273027312732273327342735273627372738273927402741274227432744274527462747274827492750275127522753275427552756275727582759276027612762276327642765276627672768276927702771277227732774277527762777277827792780278127822783278427852786278727882789279027912792279327942795279627972798279928002801280228032804280528062807280828092810281128122813281428152816281728182819282028212822282328242825282628272828282928302831283228332834283528362837283828392840284128422843284428452846284728482849285028512852285328542855285628572858285928602861286228632864286528662867286828692870287128722873287428752876287728782879288028812882288328842885288628872888288928902891289228932894289528962897289828992900290129022903290429052906290729082909291029112912291329142915291629172918291929202921292229232924292529262927292829292930293129322933293429352936293729382939294029412942294329442945294629472948294929502951295229532954295529562957295829592960296129622963
  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.31 12/2/2004 4:23:56 PM JPMugaas
  18. Adjusted for changes in Core.
  19. Rev 1.30 10/26/2004 10:33:46 PM JPMugaas
  20. Updated refs.
  21. Rev 1.29 5/16/04 5:22:54 PM RLebeau
  22. Added try...finally to CommandPost()
  23. Rev 1.28 3/1/2004 1:02:58 PM JPMugaas
  24. Fixed for new code.
  25. Rev 1.27 2004.02.03 5:44:10 PM czhower
  26. Name changes
  27. Rev 1.26 1/21/2004 3:26:58 PM JPMugaas
  28. InitComponent
  29. Rev 1.25 1/1/04 1:22:04 AM RLebeau
  30. Bug fix for parameter parsing in CommandNewNews() that was testing the
  31. ASender.Params.Count incorrectly.
  32. Rev 1.24 2003.10.21 9:13:12 PM czhower
  33. Now compiles.
  34. Rev 1.23 10/19/2003 5:39:52 PM DSiders
  35. Added localization comments.
  36. Rev 1.22 2003.10.18 9:42:10 PM czhower
  37. Boatload of bug fixes to command handlers.
  38. Rev 1.21 2003.10.12 4:04:02 PM czhower
  39. compile todos
  40. Rev 1.20 9/19/2003 03:30:10 PM JPMugaas
  41. Now should compile again.
  42. Rev 1.19 9/17/2003 10:41:56 PM PIonescu
  43. Fixed small mem leak in CommandPost
  44. Rev 1.18 8/6/2003 6:13:50 PM SPerry
  45. Message-ID Integer - > string
  46. Rev 1.17 8/2/2003 03:53:00 AM JPMugaas
  47. Unit needed to be added to uses clause.
  48. Rev 1.16 8/1/2003 8:21:38 PM SPerry
  49. Rev 1.13 5/26/2003 04:28:02 PM JPMugaas
  50. Removed GenerateReply and ParseResponse calls because those functions are
  51. being removed.
  52. Rev 1.12 5/26/2003 12:23:48 PM JPMugaas
  53. Rev 1.11 5/25/2003 03:50:48 AM JPMugaas
  54. Rev 1.10 5/21/2003 2:25:04 PM BGooijen
  55. changed due to change in IdCmdTCPServer from ReplyExceptionCode: Integer to
  56. ReplyException: TIdReply
  57. Rev 1.9 3/26/2003 04:18:26 PM JPMugaas
  58. Now supports implicit and explicit TLS.
  59. Rev 1.7 3/17/2003 08:55:52 AM JPMugaas
  60. Missing reply texts.
  61. Rev 1.6 3/16/2003 08:30:24 AM JPMugaas
  62. Reenabled ExplicitTLS according to
  63. http://www.ietf.org/internet-drafts/draft-ietf-nntpext-tls-nntp-00.txt.
  64. Support is still preliminary.
  65. Rev 1.5 1/20/2003 1:15:34 PM BGooijen
  66. Changed to TIdTCPServer / TIdCmdTCPServer classes
  67. Rev 1.4 1/17/2003 07:10:40 PM JPMugaas
  68. Now compiles under new framework.
  69. Rev 1.3 1/9/2003 06:09:28 AM JPMugaas
  70. Updated for IdContext API change.
  71. Rev 1.2 1/8/2003 05:53:38 PM JPMugaas
  72. Switched stuff to IdContext.
  73. Rev 1.1 12/7/2002 06:43:14 PM JPMugaas
  74. These should now compile except for Socks server. IPVersion has to be a
  75. property someplace for that.
  76. Rev 1.0 11/13/2002 07:58:00 AM JPMugaas
  77. July 2002
  78. -Kudzu - Fixes to Authorization and other parts
  79. Oct/Nov 2001
  80. -Kudzu - Rebuild from scratch for proper use of command handlers and around new
  81. architecture.
  82. 2001-Jul-31 Jim Gunkel
  83. Reorganized for command handlers
  84. 2001-Jun-28 Pete Mee
  85. Begun transformation to TIdCommandHandler
  86. 2000-Apr-22 Mark L. Holmes
  87. Ported to Indy
  88. 2000-Mar-27
  89. Final Version
  90. 2000-Jan-13 MTL
  91. Moved to new Palette Scheme (Winshoes Servers)
  92. }
  93. unit IdNNTPServer;
  94. interface
  95. {$i IdCompilerDefines.inc}
  96. {
  97. Original Author: Ozz Nixon (Winshoes 7)
  98. }
  99. uses
  100. Classes,
  101. IdAssignedNumbers, IdContext, IdCustomTCPServer, IdYarn, IdCommandHandlers, IdException,
  102. IdGlobal, IdCmdTCPServer, IdExplicitTLSClientServerBase,
  103. IdTCPConnection, IdReply;
  104. (*
  105. For more information on NNTP visit http://www.faqs.org/rfcs/
  106. RFC 977 - A Proposed Standard for the Stream-Based Transmission of News
  107. RFC 2980 - Common NNTP Extensions
  108. RFC 1036 - Standard for Interchange of USENET Messages
  109. RFC 822 - Standard for the Format of ARPA Internet Text
  110. http://www.ietf.org/internet-drafts/draft-ietf-nntpext-base-20.txt
  111. *)
  112. (*
  113. Responses
  114. 100 help text follows
  115. 199 debug output
  116. 200 server ready - posting allowed
  117. 201 server ready - no posting allowed
  118. 202 slave status noted
  119. 205 closing connection - goodbye!
  120. 211 n f l s group selected
  121. 215 list of newsgroups follows
  122. 220 n <a> article retrieved - head and body follow
  123. 221 n <a> article retrieved - head follows
  124. 222 n <a> article retrieved - body follows
  125. 223 n <a> article retrieved - request text separately
  126. 230 list of new articles by message-id follows
  127. 231 list of new newsgroups follows
  128. 235 article transferred ok
  129. 240 article posted ok
  130. 281 Authentication accepted
  131. 335 send article to be transferred. End with <CR-LF>.<CR-LF>
  132. 340 send article to be posted. End with <CR-LF>.<CR-LF>
  133. 381 More authentication information required
  134. 400 service discontinued
  135. 411 no such news group
  136. 412 no newsgroup has been selected
  137. 420 no current article has been selected
  138. 421 no next article in this group
  139. 422 no previous article in this group
  140. 423 no such article number in this group
  141. 430 no such article found
  142. 435 article not wanted - do not send it
  143. 436 transfer failed - try again later
  144. 437 article rejected - do not try again.
  145. 440 posting not allowed
  146. 441 posting failed
  147. 480 Authentication required
  148. 482 Authentication rejected
  149. 500 command not recognized
  150. 501 command syntax error
  151. 502 access restriction or permission denied
  152. 503 program fault - command not performed
  153. *)
  154. const
  155. DEF_NNTP_IMPLICIT_TLS = False;
  156. type
  157. EIdNNTPServerException = class(EIdException);
  158. TIdNNTPAuthType = (atUserPass, atSimple, atGeneric);
  159. TIdNNTPAuthTypes = set of TIdNNTPAuthType;
  160. TIdNNTPLookupType = (ltLookupError, ltLookupByMsgId, ltLookupByMsgNo);
  161. TIdNNTPContext = class(TIdServerContext)
  162. protected
  163. FAuthenticated : Boolean;
  164. FAuthenticator: string;
  165. FAuthEmail: String;
  166. FAuthParams: string;
  167. FAuthType: TIdNNTPAuthType;
  168. FCurrentArticle: Int64;
  169. FCurrentGroup: string;
  170. FModeReader: Boolean;
  171. FPassword: string;
  172. FUserName: string;
  173. function GetUsingTLS: Boolean;
  174. function GetCanUseExplicitTLS: Boolean;
  175. function GetTLSIsRequired: Boolean;
  176. procedure GenerateAuthEmail;
  177. public
  178. constructor Create(
  179. AConnection: TIdTCPConnection;
  180. AYarn: TIdYarn;
  181. AList: TIdContextThreadList = nil
  182. ); override;
  183. //
  184. property Authenticated: Boolean read FAuthenticated;
  185. property Authenticator: string read FAuthenticator;
  186. property AuthEmail: String read FAuthEmail;
  187. property AuthParams: string read FAuthParams;
  188. property AuthType: TIdNNTPAuthType read FAuthType;
  189. property CurrentArticle: Int64 read FCurrentArticle;
  190. property CurrentGroup: string read FCurrentGroup;
  191. property ModeReader: Boolean read FModeReader;
  192. property Password: string read FPassword;
  193. property UserName: string read FUserName;
  194. property UsingTLS : Boolean read GetUsingTLS;
  195. property CanUseExplicitTLS: Boolean read GetCanUseExplicitTLS;
  196. property TLSIsRequired: Boolean read GetTLSIsRequired;
  197. end;
  198. TIdNNTPOnAuth = procedure(AContext: TIdNNTPContext; var VAccept: Boolean) of object;
  199. TIdNNTPOnNewGroupsList = procedure(AContext: TIdNNTPContext; const ADateStamp : TDateTime; const ADistributions : String) of object;
  200. TIdNNTPOnNewNews = procedure(AContext: TIdNNTPContext; const Newsgroups : String; const ADateStamp : TDateTime; const ADistributions : String) of object;
  201. TIdNNTPOnIHaveCheck = procedure(AContext: TIdNNTPContext; const AMsgID : String; VAccept : Boolean) of object;
  202. TIdNNTPOnMsgDataByNo = procedure(AContext: TIdNNTPContext; const AMsgNo: Int64) of object;
  203. TIdNNTPOnMsgDataByID = procedure(AContext: TIdNNTPContext; const AMsgID: string) of object;
  204. TIdNNTPOnCheckMsgNo = procedure(AContext: TIdNNTPContext; const AMsgNo: Int64;
  205. var VMsgID: string) of object;
  206. TIdNNTPOnCheckMsgID = procedure(AContext: TIdNNTPContext; const AMsgId : string; var VMsgNo : Int64) of object;
  207. //this has to be a separate event type in case a NNTP client selects a message
  208. //by Message ID instead of Index number. If that happens, the user has to
  209. //to return the index number. NNTP Clients setting STAT by Message ID is not
  210. //a good idea but is valid.
  211. TIdNNTPOnMovePointer = procedure(AContext: TIdNNTPContext; var AMsgNo: Int64; var VMsgID: string) of object;
  212. TIdNNTPOnPost = procedure(AContext: TIdNNTPContext; var VPostOk: Boolean; var VErrorText: string) of object;
  213. TIdNNTPOnSelectGroup = procedure(AContext: TIdNNTPContext; const AGroup: string;
  214. var VMsgCount: Int64; var VMsgFirst: Int64; var VMsgLast: Int64;
  215. var VGroupExists: Boolean) of object;
  216. TIdNNTPOnCheckListGroup = procedure(AContext: TIdNNTPContext; const AGroup: string;
  217. var VCanJoin : Boolean; var VFirstArticle : Int64) of object;
  218. TIdNNTPOnXHdr = procedure(AContext: TIdNNTPContext; const AHeaderName : String;
  219. const AMsgFirst: Int64; const AMsgLast: Int64; const AMsgID: String) of object;
  220. TIdNNTPOnXOver = procedure(AContext: TIdNNTPContext; const AMsgFirst: Int64; const AMsgLast: Int64) of object;
  221. TIdNNTPOnXPat = procedure(AContext: TIdNNTPContext; const AHeaderName : String; const AMsgFirst: Int64;
  222. const AMsgLast: Int64; const AMsgID: String; const AHeaderPattern: String) of object;
  223. TIdNNTPOnAuthRequired = procedure(AContext: TIdNNTPContext; const ACommand, AParams : string; var VRequired: Boolean) of object;
  224. TIdNNTPOnListPattern = procedure(AContext: TIdNNTPContext; const AGroupPattern: String) of object;
  225. TIdNNTPServer = class(TIdExplicitTLSServer)
  226. protected
  227. FHelp: TStrings;
  228. FDistributionPatterns: TStrings;
  229. FOverviewFormat: TStrings;
  230. FSupportedAuthTypes: TIdNNTPAuthTypes;
  231. FOnArticleById: TIdNNTPOnMsgDataById;
  232. FOnArticleByNo: TIdNNTPOnMsgDataByNo;
  233. FOnBodyById: TIdNNTPOnMsgDataById;
  234. FOnBodyByNo: TIdNNTPOnMsgDataByNo;
  235. FOnHeadById: TIdNNTPOnMsgDataById;
  236. FOnHeadByNo: TIdNNTPOnMsgDataByNo;
  237. FOnCheckMsgId: TidNNTPOnCheckMsgId;
  238. FOnCheckMsgNo: TIdNNTPOnCheckMsgNo;
  239. FOnStatMsgId : TIdNNTPOnMsgDataById;
  240. FOnStatMsgNo : TIdNNTPOnMsgDataByNo;
  241. FOnNextArticle : TIdNNTPOnMovePointer;
  242. FOnPrevArticle : TIdNNTPOnMovePointer;
  243. //LISTGROUP events - Gravity uses these
  244. FOnCheckListGroup : TIdNNTPOnCheckListGroup;
  245. FOnListActiveGroups: TIdNNTPOnListPattern;
  246. FOnListActiveGroupTimes: TIdNNTPOnListPattern;
  247. FOnListDescriptions : TIdNNTPOnListPattern;
  248. FOnListDistributions : TIdServerThreadEvent;
  249. FOnListExtensions: TIdServerThreadEvent;
  250. FOnListHeaders: TIdServerThreadEvent;
  251. FOnListSubscriptions : TIdServerThreadEvent;
  252. FOnListGroup : TIdServerThreadEvent;
  253. FOnListGroups: TIdServerThreadEvent;
  254. FOnListNewGroups : TIdNNTPOnNewGroupsList;
  255. FOnPost: TIdNNTPOnPost;
  256. FOnSelectGroup: TIdNNTPOnSelectGroup;
  257. FOnXHdr: TIdNNTPOnXHdr;
  258. FOnXOver: TIdNNTPOnXOver;
  259. FOnXROver: TIdNNTPOnXOver;
  260. FOnXPat: TIdNNTPOnXPat;
  261. FOnNewNews : TIdNNTPOnNewNews;
  262. FOnIHaveCheck : TIdNNTPOnIHaveCheck;
  263. FOnIHavePost: TIdNNTPOnPost;
  264. FOnAuth: TIdNNTPOnAuth;
  265. FOnAuthRequired: TIdNNTPOnAuthRequired;
  266. function SecLayerRequired(ASender: TIdCommand) : Boolean;
  267. function AuthRequired(ASender: TIdCommand): Boolean;
  268. function DoCheckMsgID(AContext: TIdNNTPContext; const AMsgID: String): Int64;
  269. function DoCheckMsgNo(AContext: TIdNNTPContext; const AMsgNo: Int64): String;
  270. //return MsgID - AThread.CurrentArticlePointer already set
  271. function RawNavigate(AContext: TIdNNTPContext; AEvent : TIdNNTPOnMovePointer) : String;
  272. procedure CommandArticle(ASender: TIdCommand);
  273. procedure CommandAuthInfoUser(ASender: TIdCommand);
  274. procedure CommandAuthInfoPassword(ASender: TIdCommand);
  275. procedure CommandAuthInfoSimple(ASender: TIdCommand);
  276. procedure CommandAuthInfoGeneric(ASender: TIdCommand);
  277. procedure CommandBody(ASender: TIdCommand);
  278. procedure CommandDate(ASender: TIdCommand);
  279. procedure CommandHead(ASender: TIdCommand);
  280. procedure CommandHelp(ASender: TIdCommand);
  281. procedure CommandGroup(ASender: TIdCommand);
  282. procedure CommandIHave(ASender: TIdCommand);
  283. procedure CommandLast(ASender: TIdCommand);
  284. procedure CommandList(ASender: TIdCommand);
  285. procedure CommandListActiveGroups(ASender: TIdCommand);
  286. procedure CommandListActiveTimes(ASender: TIdCommand);
  287. procedure CommandListDescriptions(ASender: TidCommand);
  288. procedure CommandListDistributions(ASender: TIdCommand);
  289. procedure CommandListDistribPats(ASender: TIdCommand);
  290. procedure CommandListExtensions(ASender: TIdCommand);
  291. procedure CommandListGroup(ASender: TIdCommand);
  292. procedure CommandListHeaders(ASender: TIdCommand);
  293. procedure CommandListOverview(ASender: TIdCommand);
  294. procedure CommandListSubscriptions(ASender: TIdCommand);
  295. procedure CommandModeReader(ASender: TIdCommand);
  296. procedure CommandNewGroups(ASender: TIdCommand);
  297. procedure CommandNewNews(ASender: TIdCommand);
  298. procedure CommandNext(ASender: TIdCommand);
  299. procedure CommandPost(ASender: TIdCommand);
  300. procedure CommandSlave(ASender: TIdCommand);
  301. procedure CommandStat(ASender: TIdCommand);
  302. procedure CommandXHdr(ASender: TIdCommand);
  303. procedure CommandXOver(ASender: TIdCommand);
  304. procedure CommandXROver(ASender: TIdCommand);
  305. procedure CommandXPat(ASender: TIdCommand);
  306. procedure CommandSTARTTLS(ASender: TIdCommand);
  307. procedure DoListGroups(AContext: TIdNNTPContext);
  308. procedure DoSelectGroup(AContext: TIdNNTPContext; const AGroup: string; var VMsgCount: Int64;
  309. var VMsgFirst: Int64; var VMsgLast: Int64; var VGroupExists: Boolean);
  310. procedure InitializeCommandHandlers; override;
  311. procedure SetDistributionPatterns(AValue: TStrings);
  312. procedure SetHelp(AValue: TStrings);
  313. procedure SetOverviewFormat(AValue: TStrings);
  314. function GetImplicitTLS: Boolean;
  315. procedure SetImplicitTLS(const AValue: Boolean);
  316. procedure InitComponent; override;
  317. function LookupMessage(ASender : TidCommand; var VNo : Int64; var VId : string) : TIdNNTPLookupType;
  318. function LookupMessageRange(ASender: TIdCommand; const AData: String;
  319. var VMsgFirst: Int64; var VMsgLast: Int64) : Boolean;
  320. function LookupMessageRangeOrID(ASender: TIdCommand; const AData: String;
  321. var VMsgFirst: Int64; var VMsgLast: Int64; var VMsgID: String) : Boolean;
  322. public
  323. destructor Destroy; override;
  324. class function NNTPTimeToTime(const ATimeStamp : String): TDateTime;
  325. class function NNTPDateTimeToDateTime(const ATimeStamp: string): TDateTime;
  326. published
  327. property DistributionPatterns: TStrings read FDistributionPatterns write SetDistributionPatterns;
  328. property Help: TStrings read FHelp write SetHelp;
  329. property ImplicitTLS : Boolean read GetImplicitTLS write SetImplicitTLS default DEF_NNTP_IMPLICIT_TLS; // deprecated 'Use UseTLS property';
  330. property DefaultPort default IdPORT_NNTP;
  331. property UseTLS;
  332. property OverviewFormat: TStrings read FOverviewFormat write SetOverviewFormat;
  333. property SupportedAuthTypes: TIdNNTPAuthTypes read FSupportedAuthTypes write FSupportedAuthTypes;
  334. property OnArticleById: TIdNNTPOnMsgDataById read FOnArticleById write FOnArticleById;
  335. property OnArticleByNo: TIdNNTPOnMsgDataByNo read FOnArticleByNo write FOnArticleByNo;
  336. property OnAuth: TIdNNTPOnAuth read FOnAuth write FOnAuth;
  337. property OnAuthRequired : TIdNNTPOnAuthRequired read FOnAuthRequired write FOnAuthRequired;
  338. property OnBodyById: TIdNNTPOnMsgDataById read FOnBodyById write FOnBodyById;
  339. property OnBodyByNo: TIdNNTPOnMsgDataByNo read FOnBodyByNo write FOnBodyByNo;
  340. property OnCheckMsgNo: TIdNNTPOnCheckMsgNo read FOnCheckMsgNo write FOnCheckMsgNo;
  341. property OnCheckMsgID: TidNNTPOnCheckMsgId read FOnCheckMsgId write FOnCheckMsgId;
  342. property OnHeadById: TIdNNTPOnMsgDataById read FOnHeadById write FOnHeadById;
  343. property OnHeadByNo: TIdNNTPOnMsgDataByNo read FOnHeadByNo write FOnHeadByNo;
  344. property OnIHaveCheck : TIdNNTPOnIHaveCheck read FOnIHaveCheck write FOnIHaveCheck;
  345. property OnIHavePost: TIdNNTPOnPost read FOnIHavePost write FOnIHavePost;
  346. property OnStatMsgId : TIdNNTPOnMsgDataById read FOnStatMsgId write FOnStatMsgId;
  347. property OnStatMsgNo : TIdNNTPOnMsgDataByNo read FOnStatMsgNo write FOnStatMsgNo;
  348. //You are responsible for writing event handlers for these instead of us incrementing
  349. //and decrimenting the pointer. This design permits you to implement article expirity,
  350. //cancels, and supercedes
  351. property OnNextArticle : TIdNNTPOnMovePointer read FOnNextArticle write FOnNextArticle;
  352. property OnPrevArticle : TIdNNTPOnMovePointer read FOnPrevArticle write FOnPrevArticle;
  353. property OnCheckListGroup : TIdNNTPOnCheckListGroup read FOnCheckListGroup write FOnCheckListGroup;
  354. property OnListActiveGroups: TIdNNTPOnListPattern read FOnListActiveGroups write FOnListActiveGroups;
  355. property OnListActiveGroupTimes: TIdNNTPOnListPattern read FOnListActiveGroupTimes write FOnListActiveGroupTimes;
  356. property OnListDescriptions : TIdNNTPOnListPattern read FOnListDescriptions write FOnListDescriptions;
  357. property OnListDistributions : TIdServerThreadEvent read FOnListDistributions write FOnListDistributions;
  358. property OnListExtensions : TIdServerThreadEvent read FOnListExtensions write FOnListExtensions;
  359. property OnListGroup : TIdServerThreadEvent read FOnListGroup write FOnListGroup;
  360. property OnListGroups: TIdServerThreadEvent read FOnListGroups write FOnListGroups;
  361. property OnListHeaders : TIdServerThreadEvent read FOnListHeaders write FOnListHeaders;
  362. property OnListNewGroups : TIdNNTPOnNewGroupsList read FOnListNewGroups write FOnListNewGroups;
  363. property OnListSubscriptions : TIdServerThreadEvent read FOnListSubscriptions write FOnListSubscriptions;
  364. property OnNewNews : TIdNNTPOnNewNews read FOnNewNews write FOnNewNews;
  365. property OnSelectGroup: TIdNNTPOnSelectGroup read FOnSelectGroup write FOnSelectGroup;
  366. property OnPost: TIdNNTPOnPost read FOnPost write FOnPost;
  367. property OnXHdr: TIdNNTPOnXHdr read FOnXHdr write FOnXHdr;
  368. property OnXOver: TIdNNTPOnXOver read FOnXOver write FOnXOver;
  369. property OnXPat: TIdNNTPOnXPat read FOnXPat write FOnXPat;
  370. property OnXROver: TIdNNTPOnXOver read FOnXROver write FOnXROver;
  371. end;
  372. implementation
  373. uses
  374. {$IFDEF USE_VCL_POSIX}
  375. Posix.SysTime,
  376. Posix.Time,
  377. {$ENDIF}
  378. IdGlobalProtocols,
  379. IdIOHandlerSocket,
  380. IdResourceStringsProtocols,
  381. IdReplyRFC,
  382. IdStack,
  383. IdSSL,
  384. SysUtils;
  385. {CH const
  386. AuthTypes: array [1..2] of string = ('USER', 'PASS'); } {Do not localize}
  387. class function TIdNNTPServer.NNTPTimeToTime(const ATimeStamp : String): TDateTime;
  388. var
  389. LHr, LMn, LSec : Word;
  390. LTimeStr : String;
  391. begin
  392. if ATimeStamp <> '' then {do not localize}
  393. begin
  394. LHr := IndyStrToInt(Copy(ATimeStamp,1,2), 1);
  395. LMn := IndyStrToInt(Copy(ATimeStamp,3,4), 1);
  396. LSec := IndyStrToInt(Copy(ATimeStamp,5,6), 1);
  397. Result := EncodeTime(LHr, LMn, LSec, 0);
  398. LTimeStr := Trim(Copy(ATimeStamp,7,MaxInt));
  399. if TextIsSame(LTimeStr, 'GMT') then {do not localize}
  400. begin
  401. // Apply local offset
  402. Result := UTCTimeToLocalTime(Result);
  403. end;
  404. end else begin
  405. Result := 0.0;
  406. end;
  407. end;
  408. class function TIdNNTPServer.NNTPDateTimeToDateTime(const ATimeStamp : String): TDateTime;
  409. var
  410. LYr, LMo, LDay : Word;
  411. LTimeStr : String;
  412. LDateStr : String;
  413. begin
  414. Result := 0;
  415. if ATimeStamp <> '' then {do not localize}
  416. begin
  417. LTimeStr := ATimeStamp;
  418. LDateStr := Fetch(LTimeStr);
  419. if Length(LDateStr) > 6 then begin
  420. //four digit year, good idea - IMAO
  421. LYr := IndyStrToInt(Copy(LDateStr,1,4), 1969);
  422. Delete(LDateStr,1,4);
  423. end else begin
  424. LYr := IndyStrToInt(Copy(LDateStr,1,2), 69);
  425. Delete(LDateStr,1,2);
  426. Inc(LYr, 2000);
  427. end;
  428. LMo := IndyStrToInt(Copy(LDateStr,1,2), 1);
  429. Delete(LDateStr,1,2);
  430. LDay := IndyStrToInt(Copy(LDateStr,1,2), 1);
  431. Delete(LDateStr,1,2);
  432. Result := EncodeDate(LYr, LMo, LDay) + NNTPTimeToTime(LTimeStr);
  433. end;
  434. end;
  435. (*
  436. 3.1. The ARTICLE, BODY, HEAD, and STAT commands
  437. There are two forms to the ARTICLE command (and the related BODY,
  438. HEAD, and STAT commands), each using a different method of specifying
  439. which article is to be retrieved. When the ARTICLE command is
  440. followed by a message-id in angle brackets ("<" and ">"), the first
  441. form of the command is used; when a numeric parameter or no parameter
  442. is supplied, the second form is invoked.
  443. The text of the article is returned as a textual response, as
  444. described earlier in this document.
  445. The HEAD and BODY commands are identical to the ARTICLE command
  446. except that they respectively return only the header lines or text
  447. body of the article.
  448. The STAT command is similar to the ARTICLE command except that no
  449. text is returned. When selecting by message number within a group,
  450. the STAT command serves to set the current article pointer without
  451. sending text. The returned acknowledgement response will contain the
  452. message-id, which may be of some value. Using the STAT command to
  453. select by message-id is valid but of questionable value, since a
  454. selection by message-id does NOT alter the "current article pointer".
  455. 3.1.1. ARTICLE (selection by message-id)
  456. ARTICLE <message-id>
  457. Display the header, a blank line, then the body (text) of the
  458. specified article. Message-id is the message id of an article as
  459. shown in that article's header. It is anticipated that the client
  460. will obtain the message-id from a list provided by the NEWNEWS
  461. command, from references contained within another article, or from
  462. the message-id provided in the response to some other commands.
  463. Please note that the internally-maintained "current article pointer"
  464. is NOT ALTERED by this command. This is both to facilitate the
  465. presentation of articles that may be referenced within an article
  466. being read, and because of the semantic difficulties of determining
  467. the proper sequence and membership of an article which may have been
  468. posted to more than one newsgroup.
  469. 3.1.2. ARTICLE (selection by number)
  470. ARTICLE [nnn]
  471. Displays the header, a blank line, then the body (text) of the
  472. current or specified article. The optional parameter nnn is the
  473. numeric id of an article in the current newsgroup and must be chosen
  474. from the range of articles provided when the newsgroup was selected.
  475. If it is omitted, the current article is assumed.
  476. The internally-maintained "current article pointer" is set by this
  477. command if a valid article number is specified.
  478. [the following applies to both forms of the article command.] A
  479. response indicating the current article number, a message-id string,
  480. and that text is to follow will be returned.
  481. The message-id string returned is an identification string contained
  482. within angle brackets ("<" and ">"), which is derived from the header
  483. of the article itself. The Message-ID header line (required by
  484. RFC850) from the article must be used to supply this information. If
  485. the message-id header line is missing from the article, a single
  486. digit "0" (zero) should be supplied within the angle brackets.
  487. Since the message-id field is unique with each article, it may be
  488. used by a news reading program to skip duplicate displays of articles
  489. that have been posted more than once, or to more than one newsgroup.
  490. 3.1.3. Responses
  491. 220 n <a> article retrieved - head and body follow
  492. (n = article number, <a> = message-id)
  493. 221 n <a> article retrieved - head follows
  494. 222 n <a> article retrieved - body follows
  495. 223 n <a> article retrieved - request text separately
  496. 412 no newsgroup has been selected
  497. 420 no current article has been selected
  498. 423 no such article number in this group
  499. 430 no such article found
  500. *)
  501. // Note - we dont diffentiate between 423 and 430, we always return 430
  502. procedure TIdNNTPServer.CommandArticle(ASender: TIdCommand);
  503. var
  504. LMsgID: string;
  505. LMsgNo: Int64;
  506. begin
  507. if not SecLayerRequired(ASender) then begin
  508. if not AuthRequired(ASender) then begin
  509. case LookupMessage(ASender, LMsgNo, LMsgID) of
  510. ltLookupByMsgId: begin
  511. if Assigned(FOnArticleById) then begin
  512. ASender.Reply.SetReply(220, IntToStr(LMsgNo) + ' ' + LMsgID + ' article retrieved - head and body follow'); {do not localize}
  513. ASender.SendReply;
  514. FOnArticleById(TIdNNTPContext(ASender.Context), LMsgId);
  515. end else begin
  516. ASender.Reply.NumericCode := 500;
  517. end;
  518. end;
  519. ltLookupByMsgNo: begin
  520. if Assigned(FOnArticleByNo) then begin
  521. ASender.Reply.SetReply(220, IntToStr(LMsgNo) + ' ' + LMsgID + ' article retrieved - head and body follow'); {do not localize}
  522. ASender.SendReply;
  523. FOnArticleByNo(TIdNNTPContext(ASender.Context), LMsgNo);
  524. end else begin
  525. ASender.Reply.NumericCode := 500;
  526. end;
  527. end;
  528. // ltLookupError is already handled inside of LookupMessage()
  529. end;
  530. end;
  531. end;
  532. end;
  533. // Note - we dont diffentiate between 423 and 430, we always return 430
  534. procedure TIdNNTPServer.CommandBody(ASender: TIdCommand);
  535. var
  536. LMsgID: string;
  537. LMsgNo: Int64;
  538. begin
  539. if not SecLayerRequired(ASender) then begin
  540. if not AuthRequired(ASender) then begin
  541. case LookupMessage(ASender, LMsgNo, LMsgID) of
  542. ltLookupByMsgId: begin
  543. if Assigned(FOnBodyById) then begin
  544. ASender.Reply.SetReply(220, IntToStr(LMsgNo) + ' ' + LMsgID + ' article retrieved - body follows'); {do not localize}
  545. ASender.SendReply;
  546. FOnBodyById(TIdNNTPContext(ASender.Context), LMsgId);
  547. end else begin
  548. ASender.Reply.NumericCode := 500;
  549. end;
  550. end;
  551. ltLookupByMsgNo: begin
  552. if Assigned(FOnBodyByNo) then begin
  553. ASender.Reply.SetReply(220, IntToStr(LMsgNo) + ' ' + LMsgID + ' article retrieved - body follows'); {do not localize}
  554. ASender.SendReply;
  555. FOnBodyByNo(TIdNNTPContext(ASender.Context), LMsgNo);
  556. end else begin
  557. ASender.Reply.NumericCode := 500;
  558. end;
  559. end;
  560. // ltLookupError is already handled inside of LookupMessage()
  561. end;
  562. end;
  563. end;
  564. end;
  565. procedure TIdNNTPServer.CommandDate(ASender: TIdCommand);
  566. begin
  567. if not SecLayerRequired(ASender) then begin
  568. ASender.Reply.SetReply(111, FormatDateTime('yyyymmddhhnnss', LocalTimeToUTCTime(Now))); {do not localize}
  569. end;
  570. end;
  571. {*
  572. 3.3. The HELP command
  573. 3.3.1. HELP
  574. HELP
  575. Provides a short summary of commands that are understood by this
  576. implementation of the server. The help text will be presented as a
  577. textual response, terminated by a single period on a line by itself.
  578. 3.3.2. Responses
  579. 100 help text follows
  580. *}
  581. procedure TIdNNTPServer.CommandHelp(ASender: TIdCommand);
  582. begin
  583. if Help.Count > 0 then begin
  584. ASender.Response.Assign(Help);
  585. end else begin
  586. ASender.Response.Text := 'No help available.'; {do not localize}
  587. end;
  588. end;
  589. (*
  590. 3.2. The GROUP command
  591. 3.2.1. GROUP
  592. GROUP ggg
  593. The required parameter ggg is the name of the newsgroup to be
  594. selected (e.g. "net.news"). A list of valid newsgroups may be
  595. obtained from the LIST command.
  596. The successful selection response will return the article numbers of
  597. the first and last articles in the group, and an estimate of the
  598. number of articles on file in the group. It is not necessary that
  599. the estimate be correct, although that is helpful; it must only be
  600. equal to or larger than the actual number of articles on file. (Some
  601. implementations will actually count the number of articles on file.
  602. Others will just subtract first article number from last to get an
  603. estimate.)
  604. When a valid group is selected by means of this command, the
  605. internally maintained "current article pointer" is set to the first
  606. article in the group. If an invalid group is specified, the
  607. previously selected group and article remain selected. If an empty
  608. newsgroup is selected, the "current article pointer" is in an
  609. indeterminate state and should not be used.
  610. Note that the name of the newsgroup is not case-dependent. It must
  611. otherwise match a newsgroup obtained from the LIST command or an
  612. error will result.
  613. 3.2.2. Responses
  614. 211 n f l s group selected
  615. (n = estimated number of articles in group,
  616. f = first article number in the group,
  617. l = last article number in the group,
  618. s = name of the group.)
  619. 411 no such news group
  620. *)
  621. procedure TIdNNTPServer.CommandGroup(ASender: TIdCommand);
  622. var
  623. LGroup: string;
  624. LGroupExists: Boolean;
  625. LMsgCount: Int64;
  626. LMsgFirst: Int64;
  627. LMsgLast: Int64;
  628. LContext: TIdNNTPContext;
  629. begin
  630. if not SecLayerRequired(ASender) then begin
  631. if not AuthRequired(ASender) then begin
  632. LGroup := Trim(ASender.UnparsedParams);
  633. LContext := TIdNNTPContext(ASender.Context);
  634. DoSelectGroup(LContext, LGroup, LMsgCount, LMsgFirst, LMsgLast, LGroupExists);
  635. if LGroupExists then begin
  636. LContext.FCurrentGroup := LGroup;
  637. ASender.Reply.SetReply(211, IndyFormat('%d %d %d %s', [LMsgCount, LMsgFirst, LMsgLast, LGroup])); {do not localize}
  638. end;
  639. end;
  640. end;
  641. end;
  642. procedure TIdNNTPServer.CommandHead(ASender: TIdCommand);
  643. // Note - we dont diffentiate between 423 and 430, we always return 430
  644. var
  645. LMsgID: string;
  646. LMsgNo: Int64;
  647. begin
  648. if not SecLayerRequired(ASender) then begin
  649. if not AuthRequired(ASender) then begin
  650. case LookupMessage(ASender, LMsgNo, LMsgID) of
  651. ltLookupByMsgId: begin
  652. if Assigned(FOnHeadById) then begin
  653. ASender.Reply.SetReply(220, IntToStr(LMsgNo) + ' ' + LMsgID + ' article retrieved - head follows'); {do not localize}
  654. ASender.SendReply;
  655. FOnHeadById(TIdNNTPContext(ASender.Context), LMsgID);
  656. end else begin
  657. ASender.Reply.NumericCode := 500;
  658. end;
  659. end;
  660. ltLookupByMsgNo: begin
  661. if Assigned(FOnHeadByNo) then begin
  662. ASender.Reply.SetReply(220, IntToStr(LMsgNo) + ' ' + LMsgID + ' article retrieved - head follows'); {do not localize}
  663. ASender.SendReply;
  664. FOnHeadByNo(TIdNNTPContext(ASender.Context), LMsgNo);
  665. end else begin
  666. ASender.Reply.NumericCode := 500;
  667. end;
  668. end;
  669. // ltLookupError is already handled inside of LookupMessage()
  670. end;
  671. end;
  672. end;
  673. end;
  674. procedure TIdNNTPServer.CommandIHave(ASender: TIdCommand);
  675. var
  676. LContext : TIdNNTPContext;
  677. LMsgID : String;
  678. LAccept:Boolean;
  679. LErrorText : String;
  680. begin
  681. if not SecLayerRequired(ASender) then begin
  682. if not AuthRequired(ASender) then begin
  683. LContext := TIdNNTPContext(ASender.Context);
  684. LMsgID := Trim(ASender.UnparsedParams);
  685. if TextStartsWith(LMsgID, '<') then begin {do not localize}
  686. if Assigned(FOnIHaveCheck) and Assigned(FOnPost) then begin
  687. FOnIHaveCheck(LContext, LMsgID, LAccept);
  688. if LAccept then begin
  689. ASender.Reply.SetReply(335, 'send article to be transferred. End with <CRLF>.<CRLF>'); {do not localize}
  690. ASender.SendReply;
  691. LErrorText := ''; {do not localize}
  692. FOnPost(LContext, LAccept, LErrorText);
  693. ASender.Reply.SetReply(iif(LAccept, 235, 436), LErrorText);
  694. end else begin
  695. ASender.Reply.NumericCode := 435;
  696. end;
  697. end else begin
  698. ASender.Reply.NumericCode := 500;
  699. end;
  700. end;
  701. end;
  702. end;
  703. end;
  704. procedure TIdNNTPServer.CommandLast(ASender: TIdCommand);
  705. var
  706. LMsgNo: Int64;
  707. LContext: TIdNNTPContext;
  708. LMsgID : String;
  709. begin
  710. if not SecLayerRequired(ASender) then begin
  711. if not AuthRequired(ASender) then begin
  712. if Assigned(FOnPrevArticle) then begin
  713. LContext := TIdNNTPContext(ASender.Context);
  714. //we do this in a round about way in case there is no previous article at all
  715. LMsgNo := LContext.CurrentArticle;
  716. LMsgID := RawNavigate(LContext, FOnPrevArticle);
  717. if LMsgID <> '' then begin {do not localize}
  718. ASender.Reply.SetReply(223, IntToStr(LMsgNo) + ' ' + LMsgID + ' article retrieved - request text separately'); {do not localize}
  719. end else begin
  720. ASender.Reply.NumericCode := 430;
  721. end;
  722. end else begin
  723. ASender.Reply.NumericCode := 500;
  724. end;
  725. end;
  726. end;
  727. end;
  728. (*
  729. 3.6. The LIST command
  730. 3.6.1. LIST
  731. LIST
  732. Returns a list of valid newsgroups and associated information. Each
  733. newsgroup is sent as a line of text in the following format:
  734. group last first p
  735. where <group> is the name of the newsgroup, <last> is the number of
  736. the last known article currently in that newsgroup, <first> is the
  737. number of the first article currently in the newsgroup, and <p> is
  738. either 'y' or 'n' indicating whether posting to this newsgroup is
  739. allowed ('y') or prohibited ('n').
  740. The <first> and <last> fields will always be numeric. They may have
  741. leading zeros. If the <last> field evaluates to less than the
  742. <first> field, there are no articles currently on file in the
  743. newsgroup.
  744. Note that posting may still be prohibited to a client even though the
  745. LIST command indicates that posting is permitted to a particular
  746. newsgroup. See the POST command for an explanation of client
  747. prohibitions. The posting flag exists for each newsgroup because
  748. some newsgroups are moderated or are digests, and therefore cannot be
  749. posted to; that is, articles posted to them must be mailed to a
  750. moderator who will post them for the submitter. This is independent
  751. of the posting permission granted to a client by the NNTP server.
  752. Please note that an empty list (i.e., the text body returned by this
  753. command consists only of the terminating period) is a possible valid
  754. response, and indicates that there are currently no valid newsgroups.
  755. 3.6.2. Responses
  756. 215 list of newsgroups follows
  757. *)
  758. procedure TIdNNTPServer.CommandList(ASender: TIdCommand);
  759. begin
  760. if not SecLayerRequired(ASender) then begin
  761. if not AuthRequired(ASender) then begin
  762. ASender.SendReply;
  763. DoListGroups(TIdNNTPContext(ASender.Context));
  764. ASender.Context.Connection.IOHandler.WriteLn('.'); {do not localize}
  765. end;
  766. end;
  767. end;
  768. (*
  769. 7.6.1 LIST ACTIVE
  770. 7.6.1.1 Usage
  771. Syntax
  772. LIST ACTIVE [wildmat]
  773. Responses
  774. 215 Information follows (multiline)
  775. Parameters
  776. wildmat = groups of interest
  777. 7.6.1.2 Description
  778. The LIST ACTIVE command with no arguments returns a list of valid
  779. newsgroups and associated information. The server MUST include every
  780. group that the client is permitted to select with the GROUP (Section
  781. 6.1.1) command. Each newsgroup is sent as a line of text in the
  782. following format:
  783. group high low status
  784. where:
  785. "group" is the name of the newsgroup;
  786. "high" is the reported high water mark for the group;
  787. "low" is the reported low water mark for the group;
  788. "status" is the current status of the group on this server.
  789. Each field in the line is separated from its neighboring fields by
  790. one or more spaces. Note that an empty list is a possible valid
  791. response, and indicates that there are currently no valid newsgroups.
  792. The reported high and low water marks are as described in the GROUP
  793. command (see Section 6.1.1).
  794. The status field is typically one of:
  795. "y" posting is permitted
  796. "n" posting is not permitted
  797. "m" postings will be forwarded to the newsgroup moderator
  798. The server SHOULD use these values when these meanings are required
  799. and MUST NOT use them with any other meaning. Other values for the
  800. status may exist; the definition of these other values and the
  801. circumstances under which they are returned may be specified in an
  802. extension or may be private to the server. A client SHOULD treat an
  803. unrecognised status as giving no information.
  804. The status of a newsgroup only indicates how posts to that newsgroup
  805. are normally processed and is not necessarily customised to the
  806. specific client. For example, if the current client is forbidden from
  807. posting, then this will apply equally to groups with status "y".
  808. Conversely, a client with special privileges (not defined by this
  809. specification) might be able to post to a group with status "n".
  810. If the optional wildmat argument is specified, the response is
  811. limited to only the groups (if any) whose names match the wildmat. If
  812. no wildmat is specified, the keyword ACTIVE MAY be omitted without
  813. altering the effect of the command.
  814. *)
  815. procedure TIdNNTPServer.CommandListActiveGroups(ASender: TIdCommand);
  816. begin
  817. if not SecLayerRequired(ASender) then begin
  818. if not AuthRequired(ASender) then begin
  819. if Assigned(FOnListActiveGroups) then begin
  820. ASender.SendReply;
  821. FOnListActiveGroups(TIdNNTPContext(ASender.Context), ASender.UnparsedParams);
  822. ASender.Context.Connection.IOHandler.WriteLn('.'); {do not localize}
  823. end else begin
  824. ASender.Reply.NumericCode := 500;
  825. end;
  826. end;
  827. end;
  828. end;
  829. (*
  830. 7.6.2 LIST ACTIVE.TIMES
  831. 7.6.2.1 Usage
  832. This command is optional.
  833. Syntax
  834. LIST ACTIVE.TIMES [wildmat]
  835. Responses
  836. 215 Information follows (multiline)
  837. Parameters
  838. wildmat = groups of interest
  839. 7.6.2.2 Description
  840. The active.times list is maintained by some news transport systems to
  841. contain information about who created a particular newsgroup and
  842. when. Each line of this list consists of three fields separated from
  843. each other by one or more spaces. The first field is the name of the
  844. newsgroup. The second is the time when this group was created on this
  845. news server, measured in seconds since the start of January 1, 1970.
  846. The third is plain text intended to describe the entity that created
  847. the newsgroup; it is often a mailbox as defined in RFC 2822
  848. [RFC2822].
  849. The list MAY omit newsgroups for which the information is unavailable
  850. and MAY include groups not available on the server; in particular, it
  851. MAY omit all groups created before the date and time of the oldest
  852. entry. The client MUST NOT assume that the list is complete or that
  853. it matches the list returned by LIST ACTIVE. The NEWGROUPS command
  854. (Section 7.3) may provide a better way to access this information and
  855. the results of the two commands SHOULD be consistent (subject to the
  856. caveats in the description of that command).
  857. If the information is available, it is returned as a multi-line
  858. response following the 215 response code.
  859. If the optional wildmat argument is specified, the response is
  860. limited to only the groups (if any) whose names match the wildmat and
  861. for which the information is available. Note that an empty list is a
  862. possible valid response (whether or not a wildmat is specified) and
  863. indicates that there are no such groups.
  864. 2.1.3.1 Responses
  865. 215 information follows
  866. 503 program error, function not performed
  867. *)
  868. procedure TIdNNTPServer.CommandListActiveTimes(ASender: TIdCommand);
  869. begin
  870. if not SecLayerRequired(ASender) then begin
  871. if not AuthRequired(ASender) then begin
  872. if Assigned(FOnListActiveGroupTimes) then begin
  873. ASender.SendReply;
  874. FOnListActiveGroupTimes(TIdNNTPContext(ASender.Context), ASender.UnparsedParams);
  875. ASender.Context.Connection.IOHandler.WriteLn('.'); {do not localize}
  876. end else begin
  877. ASender.Reply.NumericCode := 503;
  878. end;
  879. end;
  880. end;
  881. end;
  882. (*
  883. 2. Newsreader Extensions
  884. 2.1.6 LIST NEWSGROUPS
  885. LIST NEWSGROUPS [wildmat]
  886. The newsgroups file is maintained by some news transport systems to
  887. contain the name of each news group which is active on the server and
  888. a short description about the purpose of each news group. Each line
  889. in the file contains two fields, the news group name and a short
  890. explanation of the purpose of that news group. When executed, the
  891. information is displayed following the 215 response. When display is
  892. completed, the server will send a period on a line by itself. If the
  893. information is not available, the server will return the 503
  894. response. If the optional matching parameter is specified, the list
  895. is limited to only the groups that match the pattern (no matching is
  896. done on the group descriptions). Specifying a single group is
  897. usually very efficient for the server, and multiple groups may be
  898. specified by using wildmat patterns (similar to file globbing), not
  899. regular expressions. If nothing is matched an empty list is
  900. returned, not an error.
  901. When the optional parameter is specified, this command is equivalent
  902. to the XGTITLE command, though the response code are different.
  903. 215 information follows
  904. 503 program error, function not performed
  905. *)
  906. procedure TIdNNTPServer.CommandListDescriptions(ASender: TidCommand);
  907. begin
  908. if not SecLayerRequired(ASender) then begin
  909. if not AuthRequired(ASender) then begin
  910. if Assigned(FOnListDescriptions) then begin
  911. ASender.SendReply;
  912. FOnListDescriptions(TIdNNTPContext(ASender.Context), ASender.UnparsedParams);
  913. ASender.Context.Connection.IOHandler.WriteLn('.'); {do not localize}
  914. end else begin
  915. ASender.Reply.NumericCode := 503;
  916. end;
  917. end;
  918. end;
  919. end;
  920. (*
  921. 2. Newsreader Extensions
  922. 2.1.4 LIST DISTRIBUTIONS
  923. LIST DISTRIBUTIONS
  924. The distributions file is maintained by some news transport systems
  925. to contain information about valid values for the Distribution: line
  926. in a news article header and about what the values mean. Each line
  927. contains two fields, the value and a short explanation on the meaning
  928. of the value. When executed, the information is displayed following
  929. the 215 response. When display is completed, the server will send a
  930. period on a line by itself. If the information is not available, the
  931. server will return the 503 error response. This command first
  932. appeared in the UNIX reference version.
  933. 2.1.4.1 Responses
  934. 215 information follows
  935. 503 program error, function not performed
  936. *)
  937. procedure TIdNNTPServer.CommandListDistributions(ASender: TIdCommand);
  938. begin
  939. if not SecLayerRequired(ASender) then begin
  940. if not AuthRequired(ASender) then begin
  941. if Assigned(FOnListDistributions) then begin
  942. ASender.SendReply;
  943. FOnListDistributions(TIdNNTPContext(ASender.Context));
  944. ASender.Context.Connection.IOHandler.WriteLn('.'); {do not localize}
  945. end else begin
  946. ASender.Reply.NumericCode := 503;
  947. end;
  948. end;
  949. end;
  950. end;
  951. (*
  952. 7.6.4 LIST DISTRIB.PATS
  953. 7.6.4.1 Usage
  954. This command is optional.
  955. Syntax
  956. LIST DISTRIB.PATS
  957. Responses
  958. 215 Information follows (multiline)
  959. 7.6.4.2 Description
  960. The distrib.pats list is maintained by some news transport systems to
  961. choose a value for the content of the Distribution header of a news
  962. article being posted. Each line of this list consists of three fields
  963. separated from each other by a colon (":"). The first field is a
  964. weight, the second field is a wildmat (which may be a simple group
  965. name), and the third field is a value for the Distribution header
  966. content.
  967. The client MAY use this information to construct an appropriate
  968. Distribution header given the name of a newsgroup. To do so, it
  969. should determine the lines whose second field matches the newsgroup
  970. name, select from among them the line with the highest weight (with 0
  971. being the lowest), and use the value of the third field to construct
  972. the Distribution header.
  973. If the information is available, it is returned as a multi-line
  974. response following the 215 response code.
  975. *)
  976. procedure TIdNNTPServer.CommandListDistribPats(ASender: TIdCommand);
  977. begin
  978. if DistributionPatterns.Count > 0 then begin
  979. ASender.Reply.SetReply(215, 'information follows'); {do not localize}
  980. ASender.Response.Assign(DistributionPatterns);
  981. end else begin
  982. ASender.Reply.NumericCode := 503;
  983. end;
  984. end;
  985. (*
  986. 6.1 LIST EXTENSIONS
  987. 6.1.1 Usage
  988. This command is optional.
  989. This command MUST NOT be pipelined.
  990. Syntax
  991. LIST EXTENSIONS
  992. Responses
  993. 202 Extension list follows (multiline)
  994. 402 Server has no extensions
  995. 503 Extension information not available
  996. 6.1.2 Description
  997. The LIST EXTENSIONS command allows a client to determine which
  998. extensions are supported by the server. This command MUST be
  999. implemented by any server that implements any extensions defined in
  1000. this document.
  1001. To discover what extensions are available, an NNTP client SHOULD
  1002. query the server early in the session for extensions information by
  1003. issuing the LIST EXTENSIONS command. This command MAY be issued at
  1004. anytime during a session. It is not required that the client issues
  1005. this command before attempting to make use of any extension. The
  1006. response generated by this command MAY change during a session
  1007. because of other state information. However, an NNTP client MUST NOT
  1008. cache (for use in another session) any information returned if the
  1009. LIST EXTENSIONS command succeeds. That is, an NNTP client is only
  1010. able to get the current and correct information concerning available
  1011. extensions during a session by issuing a LIST EXTENSIONS command
  1012. during that session and processing that response.
  1013. The list of extensions is returned as a multi-line response following
  1014. the 202 response code. Each extension is listed on a separate line;
  1015. the line MUST begin with an extension-label and optionally one or
  1016. more parameters (separated by single spaces). The extension-label
  1017. and the meaning of the parameters are specified as part of the
  1018. definition of the extension. The extension-label MUST be in
  1019. uppercase.
  1020. The server MUST NOT list the same extension twice in the response,
  1021. and MUST list all supported extensions. The order in which the
  1022. extensions are listed is not significant. The server need not even
  1023. consistently return the same order. If the server does not support
  1024. any extensions, a 402 response SHOULD be returned, but it MAY instead
  1025. return an empty list.
  1026. Following a 503 response an extension might still be available, and
  1027. the client MAY attempt to use it.
  1028. *)
  1029. procedure TIdNNTPServer.CommandListExtensions(ASender: TIdCommand);
  1030. begin
  1031. ASender.Reply.SetReply(202, 'Extensions supported:'); {do not localize}
  1032. ASender.SendReply;
  1033. if TIdNNTPContext(ASender.Context).CanUseExplicitTLS then begin
  1034. ASender.Context.Connection.IOHandler.WriteLn(' STARTTLS'); {do not localize}
  1035. end;
  1036. if Assigned(FOnXHdr) then begin
  1037. ASender.Context.Connection.IOHandler.WriteLn(' HDR'); {do not localize}
  1038. end;
  1039. if Assigned(FOnXOver) then begin
  1040. ASender.Context.Connection.IOHandler.WriteLn(' OVER'); {do not localize}
  1041. end;
  1042. if Assigned(FOnXROver) then begin
  1043. ASender.Context.Connection.IOHandler.WriteLn(' XROVER'); {do not localize}
  1044. end;
  1045. if Assigned(FOnXPat) then begin
  1046. ASender.Context.Connection.IOHandler.WriteLn(' XPAT'); {do not localize}
  1047. end;
  1048. if Assigned(FOnCheckListGroup) and Assigned(FOnListGroup) then begin
  1049. ASender.Context.Connection.IOHandler.WriteLn(' LISTGROUP'); {do not localize}
  1050. end;
  1051. if Assigned(FOnListActiveGroups) then begin
  1052. ASender.Context.Connection.IOHandler.WriteLn(' LIST ACTIVE'); {do not localize}
  1053. end;
  1054. if Assigned(FOnListActiveGroupTimes) then begin
  1055. ASender.Context.Connection.IOHandler.WriteLn(' LIST ACTIVE.TIMES'); {do not localize}
  1056. end;
  1057. if Assigned(FOnListDistributions) then begin
  1058. ASender.Context.Connection.IOHandler.WriteLn(' LIST DISTRIBUTIONS'); {do not localize}
  1059. end;
  1060. if DistributionPatterns.Count > 0 then begin
  1061. ASender.Context.Connection.IOHandler.WriteLn(' LIST DISTRIB.PATS'); {do not localize}
  1062. end;
  1063. if Assigned(FOnListHeaders) or (OverviewFormat.Count > 0) then begin
  1064. ASender.Context.Connection.IOHandler.WriteLn(' LIST HEADERS'); {do not localize}
  1065. end;
  1066. if Assigned(FOnListDescriptions) then begin
  1067. ASender.Context.Connection.IOHandler.WriteLn(' LIST NEWSGROUPS'); {do not localize}
  1068. end;
  1069. if Assigned(FOnListSubscriptions) then begin
  1070. ASender.Context.Connection.IOHandler.WriteLn(' LIST SUBSCRIPTIONS'); {do not localize}
  1071. end;
  1072. if Assigned(FOnListExtensions) then begin
  1073. FOnListExtensions(TIdNNTPContext(ASender.Context));
  1074. end;
  1075. ASender.Context.Connection.IOHandler.WriteLn('.'); {do not localize}
  1076. end;
  1077. procedure TIdNNTPServer.CommandListGroup(ASender: TIdCommand);
  1078. var
  1079. LContext : TIdNNTPContext;
  1080. LGroup : String;
  1081. LFirstIdx : Int64;
  1082. LCanJoin : Boolean;
  1083. begin
  1084. if not SecLayerRequired(ASender) then begin
  1085. if not AuthRequired(ASender) then begin
  1086. if Assigned(FOnCheckListGroup) and Assigned(FOnListGroup) then begin
  1087. LContext := TIdNNTPContext(ASender.Context);
  1088. LGroup := Trim(ASender.UnparsedParams);
  1089. if Length(LGroup) = 0 then begin
  1090. LGroup := LContext.CurrentGroup;
  1091. end;
  1092. LCanJoin := False;
  1093. if Length(LGroup) > 0 then begin
  1094. FOnCheckListGroup(LContext, LGroup, LCanJoin, LFirstIdx);
  1095. end;
  1096. if LCanJoin then begin
  1097. LContext.FCurrentGroup := LGroup;
  1098. LContext.FCurrentArticle := LFirstIdx;
  1099. ASender.SendReply;
  1100. FOnListGroup(LContext);
  1101. LContext.Connection.IOHandler.WriteLn('.'); {do not localize}
  1102. end else begin
  1103. ASender.Reply.NumericCode := 412;
  1104. end;
  1105. end else begin
  1106. ASender.Reply.NumericCode := 502;
  1107. end;
  1108. end;
  1109. end;
  1110. end;
  1111. (*
  1112. 8.6.2 LIST HEADERS
  1113. 8.6.2.1 Usage
  1114. Syntax
  1115. LIST HEADERS
  1116. Responses
  1117. 215 Header and metadata list follows (multiline)
  1118. 8.6.2.2 Description
  1119. The LIST HEADERS command returns a list of headers and metadata items
  1120. that may be retrieved using the HDR command.
  1121. The information is returned as a multi-line response following the
  1122. 215 response code and contains one line for each header or metadata
  1123. item name (excluding the colon in the former case). If the
  1124. implementation allows any header to be retrieved (also indicated by
  1125. the "ALL" argument to the extension label) it MUST NOT include any
  1126. header names in the list but MUST include the special entry ":" (a
  1127. single colon on its own); it MUST still list any metadata items that
  1128. are available. The order of items in the list is not significant; the
  1129. server need not even consistently return the same order. The list MAY
  1130. be empty (though in this circumstance there is little point in
  1131. providing the extension).
  1132. An implementation that also supports the OVER extension SHOULD at
  1133. least permit all the headers and metadata items listed in the output
  1134. from the LIST OVERVIEW.FMT command.
  1135. 8.6.2.3 Examples
  1136. Example of an implementation providing access to only a few headers:
  1137. [C] LIST EXTENSIONS
  1138. [S] 202 extensions supported:
  1139. [S] HDR
  1140. [S] .
  1141. [C] LIST HEADERS
  1142. [S] 215 headers supported:
  1143. [S] Subject
  1144. [S] Message-ID
  1145. [S] Xref
  1146. [S] .
  1147. Example of an implementation providing access to the same fields as
  1148. the first example in Section 8.5.2.3:
  1149. [C] LIST EXTENSIONS
  1150. [S] 202 extensions supported:
  1151. [S] OVER
  1152. [S] HDR
  1153. [S] .
  1154. [C] LIST HEADERS
  1155. [S] 215 headers and metadata items supported:
  1156. [S] Date
  1157. [S] Distribution
  1158. [S] From
  1159. [S] Message-ID
  1160. [S] References
  1161. [S] Subject
  1162. [S] Xref
  1163. [S] :bytes
  1164. [S] :lines
  1165. [S] .
  1166. Example of an implementation providing access to all headers:
  1167. [C] LIST EXTENSIONS
  1168. [S] 202 extensions supported:
  1169. [S] HDR ALL
  1170. [S] .
  1171. [C] LIST HEADERS
  1172. [S] 215 metadata items supported:
  1173. [S] :
  1174. [S] :lines
  1175. [S] :bytes
  1176. [S] :x-article-number
  1177. [S] .
  1178. *)
  1179. procedure TIdNNTPServer.CommandListHeaders(ASender: TIdCommand);
  1180. begin
  1181. if Assigned(FOnListHeaders) or (OverviewFormat.Count > 0) then begin
  1182. ASender.Reply.SetReply(215, 'Headers and metadata items supported:'); {do not localize}
  1183. if Assigned(FOnListHeaders) then begin
  1184. ASender.SendReply;
  1185. FOnListHeaders(TIdNNTPContext(ASender.Context));
  1186. ASender.Context.Connection.IOHandler.WriteLn('.'); {do not localize}
  1187. end else begin
  1188. ASender.Response.Assign(OverviewFormat);
  1189. end;
  1190. end else begin
  1191. ASender.Reply.NumericCode := 500;
  1192. end;
  1193. end;
  1194. (*
  1195. 2. Newsreader Extensions
  1196. 2.1.7 LIST OVERVIEW.FMT
  1197. LIST OVERVIEW.FMT
  1198. The overview.fmt file is maintained by some news transport systems to
  1199. contain the order in which header information is stored in the
  1200. overview databases for each news group. When executed, news article
  1201. header fields are displayed one line at a time in the order in which
  1202. they are stored in the overview database [5] following the 215
  1203. response. When display is completed, the server will send a period
  1204. on a line by itself. If the information is not available, the server
  1205. will return the 503 response.
  1206. Please note that if the header has the word "full" (without quotes)
  1207. after the colon, the header's name is prepended to its field in the
  1208. output returned by the server.
  1209. Many newsreaders work better if Xref: is one of the optional fields.
  1210. It is STRONGLY recommended that this command be implemented in any
  1211. server that implements the XOVER command. See section 2.8 for more
  1212. details about the XOVER command.
  1213. 2.1.7.1 Responses
  1214. 215 information follows
  1215. 503 program error, function not performed
  1216. *)
  1217. procedure TIdNNTPServer.CommandListOverview(ASender: TIdCommand);
  1218. begin
  1219. if OverviewFormat.Count > 0 then begin
  1220. ASender.Reply.SetReply(215, 'information follows'); {do not localize}
  1221. ASender.Response.Assign(OverviewFormat);
  1222. end else begin
  1223. ASender.Reply.NumericCode := 503;
  1224. end;
  1225. end;
  1226. (*
  1227. 2. Newsreader Extensions
  1228. 2.1.8 LIST SUBSCRIPTIONS
  1229. LIST SUBSCRIPTIONS
  1230. This command is used to get a default subscription list for new users
  1231. of this server. The order of groups is significant.
  1232. When this list is available, it is preceded by the 215 response and
  1233. followed by a period on a line by itself. When this list is not
  1234. available, the server returns a 503 response code.
  1235. 2.1.8.1 Responses
  1236. 215 information follows
  1237. 503 program error, function not performed
  1238. *)
  1239. procedure TIdNNTPServer.CommandListSubscriptions(ASender: TIdCommand);
  1240. begin
  1241. if not SecLayerRequired(ASender) then begin
  1242. if not AuthRequired(ASender) then begin
  1243. if Assigned(FOnListSubscriptions) then begin
  1244. ASender.Reply.SetReply(215, 'information follows'); {do not localize}
  1245. ASender.SendReply;
  1246. FOnListSubscriptions(TIdNNTPContext(ASender.Context));
  1247. ASender.Context.Connection.IOHandler.WriteLn('.');
  1248. end else begin
  1249. ASender.Reply.NumericCode := 503;
  1250. end;
  1251. end;
  1252. end;
  1253. end;
  1254. procedure TIdNNTPServer.CommandModeReader(ASender: TIdCommand);
  1255. (*
  1256. 2.3 MODE READER
  1257. MODE READER is used by the client to indicate to the server that it
  1258. is a news reading client. Some implementations make use of this
  1259. information to reconfigure themselves for better performance in
  1260. responding to news reader commands. This command can be contrasted
  1261. with the SLAVE command in RFC 977, which was not widely implemented.
  1262. MODE READER was first available in INN.
  1263. 2.3.1 Responses
  1264. 200 Hello, you can post
  1265. 201 Hello, you can't post
  1266. *)
  1267. begin
  1268. if not SecLayerRequired(ASender) then begin
  1269. TIdNNTPContext(ASender.Context).FModeReader := True;
  1270. ASender.Reply.NumericCode := 200;
  1271. end;
  1272. end;
  1273. (*
  1274. 3.7. The NEWGROUPS command
  1275. 3.7.1. NEWGROUPS
  1276. NEWGROUPS date time [GMT] [<distributions>]
  1277. A list of newsgroups created since <date and time> will be listed in
  1278. the same format as the LIST command.
  1279. The date is sent as 6 digits in the format YYMMDD, where YY is the
  1280. last two digits of the year, MM is the two digits of the month (with
  1281. leading zero, if appropriate), and DD is the day of the month (with
  1282. leading zero, if appropriate). The closest century is assumed as
  1283. part of the year (i.e., 86 specifies 1986, 30 specifies 2030, 99 is
  1284. 1999, 00 is 2000).
  1285. Time must also be specified. It must be as 6 digits HHMMSS with HH
  1286. being hours on the 24-hour clock, MM minutes 00-59, and SS seconds
  1287. 00-59. The time is assumed to be in the server's timezone unless the
  1288. token "GMT" appears, in which case both time and date are evaluated
  1289. at the 0 meridian.
  1290. The optional parameter "distributions" is a list of distribution
  1291. groups, enclosed in angle brackets. If specified, the distribution
  1292. portion of a new newsgroup (e.g, 'net' in 'net.wombat') will be
  1293. examined for a match with the distribution categories listed, and
  1294. only those new newsgroups which match will be listed. If more than
  1295. one distribution group is to be listed, they must be separated by
  1296. commas within the angle brackets.
  1297. Please note that an empty list (i.e., the text body returned by this
  1298. command consists only of the terminating period) is a possible valid
  1299. response, and indicates that there are currently no new newsgroups.
  1300. 3.7.2. Responses
  1301. 231 list of new newsgroups follows
  1302. *)
  1303. procedure TIdNNTPServer.CommandNewGroups(ASender: TIdCommand);
  1304. var
  1305. LDate : TDateTime;
  1306. LDist : String;
  1307. begin
  1308. if not SecLayerRequired(ASender) then begin
  1309. if not AuthRequired(ASender) then begin
  1310. if (ASender.Params.Count > 1) and (Assigned(FOnListNewGroups)) then begin
  1311. LDist := ''; {do not localize}
  1312. LDate := NNTPDateTimeToDateTime(ASender.Params[0]);
  1313. LDate := LDate + NNTPTimeToTime(ASender.Params[1]);
  1314. if ASender.Params.Count > 2 then begin
  1315. if TextIsSame(ASender.Params[2], 'GMT') then begin {Do not translate}
  1316. LDate := UTCTimeToLocalTime(LDate);
  1317. if ASender.Params.Count > 3 then begin
  1318. LDist := ASender.Params[3];
  1319. end;
  1320. end else begin
  1321. LDist := ASender.Params[2];
  1322. end;
  1323. end;
  1324. ASender.SendReply;
  1325. FOnListNewGroups(TIdNNTPContext(ASender.Context), LDate, LDist);
  1326. ASender.Context.Connection.IOHandler.WriteLn('.'); {do not localize}
  1327. end else begin
  1328. ASender.Reply.NumericCode := 500;
  1329. end;
  1330. end;
  1331. end;
  1332. end;
  1333. procedure TIdNNTPServer.CommandNewNews(ASender: TIdCommand);
  1334. var
  1335. LDate : TDateTime;
  1336. LDist : String;
  1337. begin
  1338. if not SecLayerRequired(ASender) then begin
  1339. if not AuthRequired(ASender) then begin
  1340. if (ASender.Params.Count > 2) and Assigned(FOnNewNews) then begin
  1341. //0 - newsgroup
  1342. //1 - date
  1343. //2 - time
  1344. //3 - GMT or distributions
  1345. //4 - distributions if 3 was GMT
  1346. LDist := ''; {do not localize}
  1347. LDate := NNTPDateTimeToDateTime(ASender.Params[1]);
  1348. LDate := LDate + NNTPTimeToTime(ASender.Params[2]);
  1349. if ASender.Params.Count > 3 then begin
  1350. if TextIsSame(ASender.Params[3], 'GMT') then begin {Do not translate}
  1351. LDate := UTCTimeToLocalTime(LDate);
  1352. if ASender.Params.Count > 4 then begin
  1353. LDist := ASender.Params[4];
  1354. end;
  1355. end else begin
  1356. LDist := ASender.Params[3];
  1357. end;
  1358. end;
  1359. ASender.SendReply;
  1360. FOnNewNews(TIdNNTPContext(ASender.Context), ASender.Params[0], LDate, LDist);
  1361. ASender.Context.Connection.IOHandler.WriteLn('.'); {do not localize}
  1362. end else begin
  1363. ASender.Reply.NumericCode := 500;
  1364. end;
  1365. end;
  1366. end;
  1367. end;
  1368. procedure TIdNNTPServer.CommandNext(ASender: TIdCommand);
  1369. var
  1370. LMsgNo: Int64;
  1371. LContext: TIdNNTPContext;
  1372. LMsgID : String;
  1373. begin
  1374. if not SecLayerRequired(ASender) then begin
  1375. if not AuthRequired(ASender) then begin
  1376. if Assigned(FOnNextArticle) then begin
  1377. LContext := TIdNNTPContext(ASender.Context);
  1378. //we do this in a round about way in case there is no previous article at all
  1379. LMsgNo := LContext.CurrentArticle;
  1380. LMsgID := RawNavigate(LContext, FOnNextArticle);
  1381. if LMsgID <> '' then begin {do not localize}
  1382. ASender.Reply.SetReply(223, IntToStr(LMsgNo) + ' ' + LMsgID + ' article retrieved - request text separately'); {do not localize}
  1383. end else begin
  1384. ASender.Reply.NumericCode := 430;
  1385. end;
  1386. end else begin
  1387. ASender.Reply.NumericCode := 500;
  1388. end;
  1389. end;
  1390. end;
  1391. end;
  1392. (*
  1393. 3.10. The POST command
  1394. 3.10.1. POST
  1395. POST
  1396. If posting is allowed, response code 340 is returned to indicate that
  1397. the article to be posted should be sent. Response code 440 indicates
  1398. that posting is prohibited for some installation-dependent reason.
  1399. If posting is permitted, the article should be presented in the
  1400. format specified by RFC850, and should include all required header
  1401. lines. After the article's header and body have been completely sent
  1402. by the client to the server, a further response code will be returned
  1403. to indicate success or failure of the posting attempt.
  1404. The text forming the header and body of the message to be posted
  1405. should be sent by the client using the conventions for text received
  1406. from the news server: A single period (".") on a line indicates the
  1407. end of the text, with lines starting with a period in the original
  1408. text having that period doubled during transmission.
  1409. No attempt shall be made by the server to filter characters, fold or
  1410. limit lines, or otherwise process incoming text. It is our intent
  1411. that the server just pass the incoming message to be posted to the
  1412. server installation's news posting software, which is separate from
  1413. this specification. See RFC850 for more details.
  1414. Since most installations will want the client news program to allow
  1415. the user to prepare his message using some sort of text editor, and
  1416. transmit it to the server for posting only after it is composed, the
  1417. client program should take note of the herald message that greeted it
  1418. when the connection was first established. This message indicates
  1419. whether postings from that client are permitted or not, and can be
  1420. used to caution the user that his access is read-only if that is the
  1421. case. This will prevent the user from wasting a good deal of time
  1422. composing a message only to find posting of the message was denied.
  1423. The method and determination of which clients and hosts may post is
  1424. installation dependent and is not covered by this specification.
  1425. 3.10.2. Responses
  1426. 240 article posted ok
  1427. 340 send article to be posted. End with <CR-LF>.<CR-LF>
  1428. 440 posting not allowed
  1429. 441 posting failed
  1430. (for reference, one of the following codes will be sent upon initial
  1431. connection; the client program should determine whether posting is
  1432. generally permitted from these:) 200 server ready - posting allowed
  1433. 201 server ready - no posting allowed
  1434. *)
  1435. procedure TIdNNTPServer.CommandPost(ASender: TIdCommand);
  1436. var
  1437. LCanPost: Boolean;
  1438. LErrorText: string;
  1439. LPostOk: Boolean;
  1440. LReply: TIdReplyRFC;
  1441. LContext : TIdNNTPContext;
  1442. begin
  1443. if not SecLayerRequired(ASender) then begin
  1444. if not AuthRequired(ASender) then begin
  1445. LContext := TIdNNTPContext(ASender.Context);
  1446. LCanPost := Assigned(FOnPost);
  1447. LReply := TIdReplyRFC.Create(nil);
  1448. try
  1449. LReply.NumericCode := iif(LCanPost, 340, 440);
  1450. ReplyTexts.UpdateText(LReply);
  1451. LContext.Connection.IOHandler.Write(LReply.FormattedReply);
  1452. finally
  1453. FreeAndNil(LReply);
  1454. end;
  1455. if LCanPost then begin
  1456. LPostOk := False;
  1457. LErrorText := ''; {do not localize}
  1458. FOnPost(LContext, LPostOk, LErrorText);
  1459. ASender.Reply.SetReply(iif(LPostOk, 240, 441), LErrorText);
  1460. end;
  1461. end;
  1462. end;
  1463. end;
  1464. procedure TIdNNTPServer.CommandSlave(ASender: TIdCommand);
  1465. begin
  1466. if not SecLayerRequired(ASender) then begin
  1467. TIdNNTPContext(ASender.Context).FModeReader := False;
  1468. ASender.Reply.NumericCode := 220;
  1469. end;
  1470. end;
  1471. procedure TIdNNTPServer.CommandStat(ASender: TIdCommand);
  1472. var
  1473. LMsgID: string;
  1474. LMsgNo: Int64;
  1475. begin
  1476. if not SecLayerRequired(ASender) then begin
  1477. if not AuthRequired(ASender) then begin
  1478. case LookupMessage(ASender, LMsgNo, LMsgID) of
  1479. ltLookupByMsgId: begin
  1480. if Assigned(FOnStatMsgId) then begin
  1481. ASender.Reply.SetReply(220, IntToStr(LMsgNo) + ' ' + LMsgID + ' article retrieved - statistics only'); {do not localize}
  1482. ASender.SendReply;
  1483. FOnStatMsgId(TIdNNTPContext(ASender.Context), LMsgID);
  1484. end else begin
  1485. ASender.Reply.NumericCode := 500;
  1486. end;
  1487. end;
  1488. ltLookupByMsgNo: begin
  1489. if Assigned(FOnStatMsgNo) then begin
  1490. ASender.Reply.SetReply(220, IntToStr(LMsgNo) + ' ' + LMsgID + ' article retrieved - statistics only'); {do not localize}
  1491. ASender.SendReply;
  1492. FOnStatMsgNo(TIdNNTPContext(ASender.Context), LMsgNo);
  1493. end else begin
  1494. ASender.Reply.NumericCode := 500;
  1495. end;
  1496. end;
  1497. // ltLookupError is already handled inside of LookupMessage()
  1498. end;
  1499. end;
  1500. end;
  1501. end;
  1502. procedure TIdNNTPServer.CommandXHdr(ASender: TIdCommand);
  1503. var
  1504. s: String;
  1505. LFirstMsg: Int64;
  1506. LLastMsg: Int64;
  1507. LMsgID: String;
  1508. LContext: TIdNNTPContext;
  1509. begin
  1510. if not SecLayerRequired(ASender) then begin
  1511. if not AuthRequired(ASender) then begin
  1512. if Assigned(FOnXHdr) then begin
  1513. if ASender.Params.Count > 0 then begin
  1514. if ASender.Params.Count > 1 then begin
  1515. s := ASender.Params[1];
  1516. end;
  1517. if LookupMessageRangeOrID(ASender, s, LFirstMsg, LLastMsg, LMsgID) then begin
  1518. LContext := TIdNNTPContext(ASender.Context);
  1519. //Note there is an inconstancy here.
  1520. //RFC 2980 says XHDR should return 221
  1521. //http://www.ietf.org/internet-drafts/draft-ietf-nntpext-base-17.txt
  1522. //says that HDR should return 225
  1523. //just return the default numeric success reply.
  1524. ASender.SendReply;
  1525. // No need for DoOnXhdr - only this proc can call it and it already checks for nil
  1526. FOnXhdr(LContext, ASender.Params[0], LFirstMsg, LLastMsg, LMsgID);
  1527. LContext.Connection.IOHandler.WriteLn('.'); {do not localize}
  1528. end;
  1529. end else begin
  1530. ASender.Reply.NumericCode := 501;
  1531. end;
  1532. end else begin
  1533. ASender.Reply.NumericCode := 500;
  1534. end;
  1535. end;
  1536. end;
  1537. end;
  1538. (*
  1539. 2.8 XOVER
  1540. XOVER [range]
  1541. The XOVER command returns information from the overview database for
  1542. the article(s) specified. This command was originally suggested as
  1543. part of the OVERVIEW work described in "The Design of a Common
  1544. Newsgroup Overview Database for Newsreaders" by Geoff Collyer. This
  1545. document is distributed in the Cnews distribution. The optional
  1546. range argument may be any of the following:
  1547. an article number
  1548. an article number followed by a dash to indicate
  1549. all following
  1550. an article number followed by a dash followed by
  1551. another article number
  1552. If no argument is specified, then information from the current
  1553. article is displayed. Successful responses start with a 224 response
  1554. followed by the overview information for all matched messages. Once
  1555. the output is complete, a period is sent on a line by itself. If no
  1556. argument is specified, the information for the current article is
  1557. returned. A news group must have been selected earlier, else a 412
  1558. error response is returned. If no articles are in the range
  1559. specified, a 420 error response is returned by the server. A 502
  1560. response will be returned if the client only has permission to
  1561. transfer articles.
  1562. Each line of output will be formatted with the article number,
  1563. followed by each of the headers in the overview database or the
  1564. article itself (when the data is not available in the overview
  1565. database) for that article separated by a tab character. The
  1566. sequence of fields must be in this order: subject, author, date,
  1567. message-id, references, byte count, and line count. Other optional
  1568. fields may follow line count. Other optional fields may follow line
  1569. count. These fields are specified by examining the response to the
  1570. LIST OVERVIEW.FMT command. Where no data exists, a null field must
  1571. be provided (i.e. the output will have two tab characters adjacent to
  1572. each other). Servers should not output fields for articles that have
  1573. been removed since the XOVER database was created.
  1574. The LIST OVERVIEW.FMT command should be implemented if XOVER is
  1575. implemented. A client can use LIST OVERVIEW.FMT to determine what
  1576. optional fields and in which order all fields will be supplied by
  1577. the XOVER command. See Section 2.1.7 for more details about the LIST
  1578. OVERVIEW.FMT command.
  1579. Note that any tab and end-of-line characters in any header data that
  1580. is returned will be converted to a space character.
  1581. 2.8.1 Responses
  1582. 224 Overview information follows
  1583. 412 No news group current selected
  1584. 420 No article(s) selected
  1585. 502 no permission
  1586. *)
  1587. procedure TIdNNTPServer.CommandXOver(ASender: TIdCommand);
  1588. var
  1589. LFirstMsg: Int64;
  1590. LLastMsg: Int64;
  1591. LContext: TIdNNTPContext;
  1592. begin
  1593. if not SecLayerRequired(ASender) then begin
  1594. if not AuthRequired(ASender) then begin
  1595. if Assigned(OnXOver) then begin
  1596. if LookupMessageRange(ASender, ASender.UnparsedParams, LFirstMsg, LLastMsg) then begin
  1597. LContext := TIdNNTPContext(ASender.Context);
  1598. ASender.Reply.NumericCode := 224;
  1599. ASender.SendReply;
  1600. FOnXOver(LContext, LFirstMsg, LLastMsg);
  1601. LContext.Connection.IOHandler.WriteLn('.'); {do not localize}
  1602. end;
  1603. end else begin
  1604. ASender.Reply.NumericCode := 500;
  1605. end;
  1606. end;
  1607. end;
  1608. end;
  1609. (*
  1610. 2.11 The XROVER command
  1611. XROVER [range]
  1612. The XROVER command returns reference information from the overview
  1613. database for the article(s) specified. This command first appeared
  1614. in the Unix reference implementation. The optional range argument
  1615. may be any of the following:
  1616. an article number
  1617. an article number followed by a dash to indicate
  1618. all following
  1619. an article number followed by a dash followed by
  1620. another article number
  1621. Successful responses start with a 224 response followed by the
  1622. contents of reference information for all matched messages. Once the
  1623. output is complete, a period is sent on a line by itself. If no
  1624. argument is specified, the information for the current article is
  1625. returned. A news group must have been selected earlier, else a 412
  1626. error response is returned. If no articles are in the range
  1627. specified, a 420 error response is returned by the server. A 502
  1628. response will be returned if the client only has permission to
  1629. transfer articles.
  1630. The output will be formatted with the article number, followed by the
  1631. contents of the References: line for that article, but does not
  1632. contain the field name itself.
  1633. This command provides the same basic functionality as using the XHDR
  1634. command and "references" as the header argument.
  1635. 2.11.1 Responses
  1636. 224 Overview information follows
  1637. 412 No news group current selected
  1638. 420 No article(s) selected
  1639. 502 no permission
  1640. *)
  1641. procedure TIdNNTPServer.CommandXROver(ASender: TIdCommand);
  1642. var
  1643. LFirstMsg: Int64;
  1644. LLastMsg: Int64;
  1645. LContext: TIdNNTPContext;
  1646. begin
  1647. if not SecLayerRequired(ASender) then begin
  1648. if not AuthRequired(ASender) then begin
  1649. if Assigned(FOnXROver) then begin
  1650. if LookupMessageRange(ASender, ASender.UnparsedParams, LFirstMsg, LLastMsg) then begin
  1651. LContext := TIdNNTPContext(ASender.Context);
  1652. ASender.Reply.NumericCode := 224;
  1653. ASender.SendReply;
  1654. FOnXROver(LContext, LFirstMsg, LLastMsg);
  1655. LContext.Connection.IOHandler.WriteLn('.'); {do not localize}
  1656. end;
  1657. end else begin
  1658. ASender.Reply.NumericCode := 500;
  1659. end;
  1660. end;
  1661. end;
  1662. end;
  1663. (*
  1664. 2.9 XPAT
  1665. XPAT header range|<message-id> pat [pat...]
  1666. The XPAT command is used to retrieve specific headers from specific
  1667. articles, based on pattern matching on the contents of the header.
  1668. This command was first available in INN.
  1669. The required header parameter is the name of a header line (e.g.
  1670. "subject") in a news group article. See RFC 1036 for a list of valid
  1671. header lines. The required range argument may be any of the
  1672. following:
  1673. an article number
  1674. an article number followed by a dash to indicate
  1675. all following
  1676. an article number followed by a dash followed by
  1677. another article number
  1678. The required message-id argument indicates a specific article. The
  1679. range and message-id arguments are mutually exclusive. At least one
  1680. pattern in wildmat must be specified as well. If there are
  1681. additional arguments the are joined together separated by a single
  1682. space to form one complete pattern. Successful responses start with
  1683. a 221 response followed by a the headers from all messages in which
  1684. the pattern matched the contents of the specified header line. This
  1685. includes an empty list. Once the output is complete, a period is
  1686. sent on a line by itself. If the optional argument is a message-id
  1687. and no such article exists, the 430 error response is returned. A
  1688. 502 response will be returned if the client only has permission to
  1689. transfer articles.
  1690. 2.9.1 Responses
  1691. 221 Header follows
  1692. 430 no such article
  1693. 502 no permission
  1694. *)
  1695. procedure TIdNNTPServer.CommandXPat(ASender: TIdCommand);
  1696. var
  1697. i: Integer;
  1698. LFirstMsg: Int64;
  1699. LLastMsg: Int64;
  1700. LMsgID: String;
  1701. LPattern: string;
  1702. LContext: TIdNNTPContext;
  1703. begin
  1704. if not SecLayerRequired(ASender) then begin
  1705. if not AuthRequired(ASender) then begin
  1706. if Assigned(OnXPat) then begin
  1707. if ASender.Params.Count > 2 then begin
  1708. if LookupMessageRangeOrID(ASender, ASender.Params[1], LFirstMsg, LLastMsg, LMsgID) then begin
  1709. LContext := TIdNNTPContext(ASender.Context);
  1710. LPattern := ASender.Params[2];
  1711. for i := 3 to (ASender.Params.Count-1) do begin
  1712. LPattern := LPattern + ' ' + ASender.Params[i]; {do not localize}
  1713. end;
  1714. ASender.Reply.SetReply(221, 'Header follows'); {do not localize}
  1715. ASender.SendReply;
  1716. FOnXPat(LContext, ASender.Params[0], LFirstMsg, LLastMsg, LMsgID, LPattern);
  1717. LContext.Connection.IOHandler.WriteLn('.'); {do not localize}
  1718. end;
  1719. end else begin
  1720. ASender.Reply.NumericCode := 501;
  1721. end;
  1722. end else begin
  1723. ASender.Reply.NumericCode := 500;
  1724. end;
  1725. end;
  1726. end;
  1727. end;
  1728. procedure TIdNNTPServer.InitComponent;
  1729. begin
  1730. inherited InitComponent;
  1731. FDistributionPatterns := TStringList.Create;
  1732. FHelp := TStringList.Create;
  1733. FOverviewFormat := TStringList.Create;
  1734. FOverviewFormat.Add('Subject:'); {do not localize}
  1735. FOverviewFormat.Add('From:'); {do not localize}
  1736. FOverviewFormat.Add('Date:'); {do not localize}
  1737. FOverviewFormat.Add('Message-ID:'); {do not localize}
  1738. FOverviewFormat.Add('References:'); {do not localize}
  1739. FOverviewFormat.Add('Bytes:'); {do not localize}
  1740. FOverviewFormat.Add('Lines:'); {do not localize}
  1741. FContextClass := TIdNNTPContext;
  1742. FRegularProtPort := IdPORT_NNTP;
  1743. FImplicitTLSProtPort := IdPORT_SNEWS;
  1744. FExplicitTLSProtPort := IdPORT_NNTP;
  1745. DefaultPort := IdPORT_NNTP;
  1746. FSupportedAuthTypes := [atUserPass];
  1747. (*
  1748. In general, 1xx codes may be ignored or displayed as desired;
  1749. code 200 or 201 is sent upon initial connection to the NNTP server
  1750. depending upon posting permission; *)
  1751. // TODO: Account for 201 as well. Right now the user can override this if they wish
  1752. Greeting.NumericCode := 200;
  1753. //
  1754. ExceptionReply.SetReply(503, RSNNTPReplyProgramFault);
  1755. ReplyUnknownCommand.SetReply(500, RSNNTPServerNotRecognized);
  1756. end;
  1757. destructor TIdNNTPServer.Destroy;
  1758. begin
  1759. FreeAndNil(FDistributionPatterns);
  1760. FreeAndNil(FHelp);
  1761. FreeAndNil(FOverviewFormat);
  1762. inherited Destroy;
  1763. end;
  1764. procedure TIdNNTPServer.DoListGroups(AContext: TIdNNTPContext);
  1765. begin
  1766. if Assigned(FOnListGroups) then begin
  1767. FOnListGroups(AContext);
  1768. end;
  1769. end;
  1770. procedure TIdNNTPServer.DoSelectGroup(AContext: TIdNNTPContext; const AGroup: string;
  1771. var VMsgCount, VMsgFirst, VMsgLast: Int64; var VGroupExists: Boolean);
  1772. begin
  1773. VMsgCount := 0;
  1774. VMsgFirst := 0;
  1775. VMsgLast := 0;
  1776. VGroupExists := False;
  1777. if Assigned(FOnSelectGroup) then begin
  1778. FOnSelectGroup(AContext, AGroup, VMsgCount, VMsgFirst, VMsgLast, VGroupExists);
  1779. end;
  1780. end;
  1781. function TIdNNTPServer.GetImplicitTLS: Boolean;
  1782. begin
  1783. Result := UseTLS = utUseImplicitTLS;
  1784. end;
  1785. procedure TIdNNTPServer.SetImplicitTLS(const AValue: Boolean);
  1786. begin
  1787. if AValue <> ImplicitTLS then begin
  1788. if AValue then begin
  1789. UseTLS := utUseImplicitTLS;
  1790. end
  1791. else if IOHandler is TIdServerIOHandlerSSLBase then begin
  1792. UseTLS := utUseExplicitTLS;
  1793. end else begin
  1794. UseTLS := utNoTLSSupport;
  1795. end;
  1796. end;
  1797. end;
  1798. procedure TIdNNTPServer.CommandSTARTTLS(ASender: TIdCommand);
  1799. var
  1800. LContext: TIdNNTPContext;
  1801. begin
  1802. LContext := TIdNNTPContext(ASender.Context);
  1803. if LContext.CanUseExplicitTLS then begin
  1804. if not LContext.UsingTLS then begin
  1805. ASender.Reply.NumericCode := 382;
  1806. ASender.SendReply;
  1807. (LContext.Connection.IOHandler as TIdSSLIOHandlerSocketBase).PassThrough := False;
  1808. //reset the connection state as required by http://www.ietf.org/internet-drafts/draft-ietf-nntpext-tls-nntp-00.txt
  1809. LContext.FUserName := ''; {do not localize}
  1810. LContext.FPassword := ''; {do not localize}
  1811. LContext.FAuthenticated := False;
  1812. LContext.FAuthenticator := ''; {do not localize}
  1813. LContext.FAuthParams := ''; {do not localize}
  1814. LContext.FAuthType := atUserPass;
  1815. LContext.FModeReader := False;
  1816. LContext.Connection.IOHandler.Write(ReplyUnknownCommand.FormattedReply);
  1817. end else begin
  1818. ASender.Reply.NumericCode := 580;
  1819. end;
  1820. end else begin
  1821. ASender.Reply.NumericCode := 500;
  1822. end;
  1823. end;
  1824. procedure TIdNNTPServer.InitializeCommandHandlers;
  1825. var
  1826. LCommandHandler: TIdCommandHandler;
  1827. begin
  1828. inherited InitializeCommandHandlers;
  1829. LCommandHandler := CommandHandlers.Add;
  1830. LCommandHandler.Command := 'ARTICLE'; {do not localize}
  1831. LCommandHandler.OnCommand := CommandArticle;
  1832. LCommandHandler.NormalReply.NumericCode := 500;
  1833. LCommandHandler.ParseParams := False;
  1834. LCommandHandler := CommandHandlers.Add;
  1835. LCommandHandler.Command := 'AUTHINFO USER'; {do not localize}
  1836. LCommandHandler.OnCommand := CommandAuthInfoUser;
  1837. LCommandHandler.NormalReply.NumericCode := 502;
  1838. LCommandHandler := CommandHandlers.Add;
  1839. LCommandHandler.Command := 'AUTHINFO PASS'; {do not localize}
  1840. LCommandHandler.OnCommand := CommandAuthInfoPassword;
  1841. LCommandHandler.NormalReply.NumericCode := 502;
  1842. LCommandHandler := CommandHandlers.Add;
  1843. LCommandHandler.Command := 'AUTHINFO SIMPLE'; {do not localize}
  1844. LCommandHandler.OnCommand := CommandAuthInfoSimple;
  1845. LCommandHandler.NormalReply.NumericCode := 350;
  1846. LCommandHandler := CommandHandlers.Add;
  1847. LCommandHandler.Command := 'AUTHINFO GENERIC'; {do not localize}
  1848. LCommandHandler.OnCommand := CommandAuthInfoGeneric;
  1849. LCommandHandler.NormalReply.NumericCode := 501;
  1850. LCommandHandler := CommandHandlers.Add;
  1851. LCommandHandler.Command := 'BODY'; {do not localize}
  1852. LCommandHandler.OnCommand := CommandBody;
  1853. LCommandHandler.ParseParams := False;
  1854. LCommandHandler := CommandHandlers.Add;
  1855. LCommandHandler.Command := 'DATE'; {do not localize}
  1856. LCommandHandler.OnCommand := CommandDate;
  1857. LCommandHandler.ParseParams := False;
  1858. LCommandHandler := CommandHandlers.Add;
  1859. LCommandHandler.Command := 'HEAD'; {do not localize}
  1860. LCommandHandler.OnCommand := CommandHead;
  1861. LCommandHandler.ParseParams := False;
  1862. LCommandHandler := CommandHandlers.Add;
  1863. LCommandHandler.Command := 'HELP'; {do not localize}
  1864. LCommandHandler.OnCommand := CommandHelp;
  1865. LCommandHandler.NormalReply.NumericCode := 100;
  1866. LCommandHandler.ParseParams := False;
  1867. LCommandHandler := CommandHandlers.Add;
  1868. LCommandHandler.Command := 'GROUP'; {do not localize}
  1869. LCommandHandler.OnCommand := CommandGroup;
  1870. LCommandHandler.NormalReply.NumericCode := 411;
  1871. LCommandHandler.ParseParams := False;
  1872. LCommandHandler := CommandHandlers.Add;
  1873. LCommandHandler.Command := 'IHAVE'; {do not localize}
  1874. LCommandHandler.OnCommand := CommandIHave;
  1875. LCommandHandler.ParseParams := False;
  1876. LCommandHandler := CommandHandlers.Add;
  1877. LCommandHandler.Command := 'LAST'; {do not localize}
  1878. LCommandHandler.OnCommand := CommandLast;
  1879. LCommandHandler.ParseParams := False;
  1880. // Before LIST
  1881. LCommandHandler := CommandHandlers.Add;
  1882. LCommandHandler.Command := 'LIST Overview.fmt'; {do not localize}
  1883. LCommandHandler.OnCommand := CommandListOverview;
  1884. LCommandHandler.ParseParams := False;
  1885. // Before LIST
  1886. //TODO: This needs implemented as events to allow return data
  1887. // RFC 2980 - NNTP Extension
  1888. LCommandHandler := CommandHandlers.Add;
  1889. LCommandHandler.Command := 'LIST NEWSGROUPS'; {do not localize}
  1890. //LCommandHandler.ReplyNormal.NumericCode := 503;
  1891. LCommandHandler.NormalReply.NumericCode := 215;
  1892. LCommandHandler.Response.Add('.');
  1893. LCommandHandler.ParseParams := False;
  1894. {
  1895. From: http://www.ietf.org/internet-drafts/draft-ietf-nntpext-base-17.txt
  1896. }
  1897. LCommandHandler := CommandHandlers.Add;
  1898. LCommandHandler.Command := 'LIST EXTENSIONS'; {do not localize}
  1899. LCommandHandler.OnCommand := CommandListExtensions;
  1900. LCommandHandler.ParseParams := False;
  1901. LCommandHandler := CommandHandlers.Add;
  1902. LCommandHandler.Command := 'LIST'; {do not localize}
  1903. LCommandHandler.OnCommand := CommandList;
  1904. LCommandHandler.NormalReply.NumericCode := 215;
  1905. LCommandHandler.ParseParams := False;
  1906. LCommandHandler := CommandHandlers.Add;
  1907. LCommandHandler.Command := 'LISTGROUP'; {do not localize}
  1908. LCommandHandler.OnCommand := CommandListGroup;
  1909. LCommandHandler.ParseParams := False;
  1910. LCommandHandler := CommandHandlers.Add;
  1911. LCommandHandler.Command := 'MODE READER'; {do not localize}
  1912. LCommandHandler.OnCommand := CommandModeReader;
  1913. LCommandHandler.ParseParams := False;
  1914. LCommandHandler := CommandHandlers.Add;
  1915. LCommandHandler.Command := 'NEWGROUPS'; {do not localize}
  1916. LCommandHandler.OnCommand := CommandNewGroups;
  1917. LCommandHandler.NormalReply.NumericCode := 231;
  1918. LCommandHandler := CommandHandlers.Add;
  1919. LCommandHandler.Command := 'NEWNEWS'; {do not localize}
  1920. LCommandHandler.OnCommand := CommandNewNews;
  1921. LCommandHandler.ParseParams := False;
  1922. LCommandHandler := CommandHandlers.Add;
  1923. LCommandHandler.Command := 'NEXT'; {do not localize}
  1924. LCommandHandler.OnCommand := CommandNext;
  1925. LCommandHandler.ParseParams := False;
  1926. LCommandHandler := CommandHandlers.Add;
  1927. LCommandHandler.Command := 'POST'; {do not localize}
  1928. LCommandHandler.OnCommand := CommandPost;
  1929. LCommandHandler.ParseParams := False;
  1930. (*
  1931. 3.11. The QUIT command
  1932. 3.11.1. QUIT
  1933. QUIT
  1934. The server process acknowledges the QUIT command and then closes the
  1935. connection to the client. This is the preferred method for a client
  1936. to indicate that it has finished all its transactions with the NNTP
  1937. server.
  1938. If a client simply disconnects (or the connection times out, or some
  1939. other fault occurs), the server should gracefully cease its attempts
  1940. to service the client.
  1941. 3.11.2. Responses
  1942. 205 closing connection - goodbye!
  1943. *)
  1944. LCommandHandler := CommandHandlers.Add;
  1945. LCommandHandler.Command := 'QUIT'; {do not localize}
  1946. LCommandHandler.Disconnect := True;
  1947. LCommandHandler.NormalReply.NumericCode := 205;
  1948. LCommandHandler.ParseParams := False;
  1949. LCommandHandler := CommandHandlers.Add;
  1950. LCommandHandler.Command := 'SLAVE'; {do not localize}
  1951. LCommandHandler.OnCommand := CommandSlave;
  1952. LCommandHandler.ParseParams := False;
  1953. LCommandHandler := CommandHandlers.Add;
  1954. LCommandHandler.Command := 'STAT'; {do not localize}
  1955. LCommandHandler.OnCommand := CommandStat;
  1956. LCommandHandler.ParseParams := False;
  1957. LCommandHandler := CommandHandlers.Add;
  1958. LCommandHandler.Command := 'XHDR'; {do not localize}
  1959. LCommandHandler.OnCommand := CommandXHdr;
  1960. LCommandHandler.ParseParams := True;
  1961. LCommandHandler.NormalReply.NumericCode := 221;
  1962. LCommandHandler := CommandHandlers.Add;
  1963. LCommandHandler.Command := 'HDR'; {do not localize}
  1964. LCommandHandler.OnCommand := CommandXHdr;
  1965. LCommandHandler.ParseParams := True;
  1966. LCommandHandler.NormalReply.NumericCode := 225;
  1967. LCommandHandler := CommandHandlers.Add;
  1968. LCommandHandler.Command := 'XOVER'; {do not localize}
  1969. LCommandHandler.OnCommand := CommandXOver;
  1970. LCommandHandler.NormalReply.NumericCode := 224;
  1971. LCommandHandler.ParseParams := False;
  1972. //from http://www.ietf.org/internet-drafts/draft-ietf-nntpext-tls-nntp-00.txt
  1973. LCommandHandler := CommandHandlers.Add;
  1974. LCommandHandler.Command := 'OVER'; {do not localize}
  1975. LCommandHandler.OnCommand := CommandXOver;
  1976. LCommandHandler.NormalReply.NumericCode := 224;
  1977. LCommandHandler.ParseParams := False;
  1978. // RFC 2980 - NNTP Extensions
  1979. LCommandHandler := CommandHandlers.Add;
  1980. LCommandHandler.Command := 'XROVER';
  1981. LCommandHandler.OnCommand := CommandXROver;
  1982. LCommandHandler.NormalReply.NumericCode := 500;
  1983. LCommandHandler.ParseParams := False;
  1984. // RFC 2980 - NNTP Extensions
  1985. LCommandHandler := CommandHandlers.Add;
  1986. LCommandHandler.Command := 'XPAT'; {do not localize}
  1987. LCommandHandler.OnCommand := CommandXPat;
  1988. LCommandHandler.NormalReply.NumericCode := 500;
  1989. LCommandHandler.ParseParams := True;
  1990. LCommandHandler := CommandHandlers.Add;
  1991. LCommandHandler.Command := 'STARTTLS'; {do not localize}
  1992. LCommandHandler.OnCommand := CommandSTARTTLS;
  1993. // 100s
  1994. FReplyTexts.Add(100, 'help text follows'); {do not localize}
  1995. FReplyTexts.Add(199, 'debug output'); {do not localize}
  1996. // 200s
  1997. FReplyTexts.Add(200, 'server ready - posting allowed'); {do not localize}
  1998. FReplyTexts.Add(201, 'server ready - no posting allowed'); {do not localize}
  1999. FReplyTexts.Add(202, 'slave status noted'); {do not localize}
  2000. FReplyTexts.Add(205, 'closing connection - goodbye!'); {do not localize}
  2001. FReplyTexts.Add(215, 'list of newsgroups follows'); {do not localize}
  2002. FReplyTexts.Add(221, 'Headers follow'); {do not localize}
  2003. FReplyTexts.Add(224, 'Overview information follows'); {do not localize}
  2004. FReplyTexts.Add(225, 'Headers follow'); {do not localize}
  2005. FReplyTexts.Add(231, 'list of new newsgroups follows'); {do not localize}
  2006. FReplyTexts.Add(235, 'article transferred ok'); {do not localize}
  2007. FReplyTexts.Add(240, 'article posted ok'); {do not localize}
  2008. FReplyTexts.Add(281,'Authentication accepted'); {do not localize}
  2009. // 300s
  2010. FReplyTexts.Add(335, 'send article to be transferred. End with <CR-LF>.<CR-LF>'); {do not localize}
  2011. FReplyTexts.Add(340, 'send article to be posted. End with <CR-LF>.<CR-LF>'); {do not localize}
  2012. FReplyTexts.Add(381, 'More authentication information required'); {do not localize}
  2013. FReplyTexts.Add(382,'Continue with TLS negotiation'); {do not localize}
  2014. // 400s
  2015. FReplyTexts.Add(400, 'service discontinued'); {do not localize}
  2016. FReplyTexts.Add(403, 'TLS temporarily not available'); {do not localize}
  2017. FReplyTexts.Add(411, 'no such news group'); {do not localize}
  2018. FReplyTexts.Add(412, 'no newsgroup has been selected'); {do not localize}
  2019. FReplyTexts.Add(420, 'no current article has been selected'); {do not localize}
  2020. FReplyTexts.Add(421, 'no next article in this group'); {do not localize}
  2021. FReplyTexts.Add(422, 'no previous article in this group'); {do not localize}
  2022. FReplyTexts.Add(423, 'no such article number in this group'); {do not localize}
  2023. FReplyTexts.Add(430, 'no such article found'); {do not localize}
  2024. FReplyTexts.Add(435, 'article not wanted - do not send it'); {do not localize}
  2025. FReplyTexts.Add(436, 'transfer failed - try again later'); {do not localize}
  2026. FReplyTexts.Add(437, 'article rejected - do not try again.'); {do not localize}
  2027. FReplyTexts.Add(440, 'posting not allowed'); {do not localize}
  2028. FReplyTexts.Add(441, 'posting failed'); {do not localize}
  2029. FReplyTexts.Add(450, 'Authorization required for this command'); {do not localize}
  2030. FReplyTexts.Add(452, 'Authorization rejected'); {do not localize}
  2031. FReplyTexts.Add(480, 'Authentication required'); {do not localize}
  2032. FReplyTexts.Add(482, 'Authentication rejected'); {do not localize}
  2033. FReplyTexts.Add(483, 'Strong encryption layer is required'); {do not localize}
  2034. // 500s
  2035. FReplyTexts.Add(500, 'command not recognized'); {do not localize}
  2036. FReplyTexts.Add(501, 'command syntax error'); {do not localize}
  2037. FReplyTexts.Add(502, 'access restriction or permission denied'); {do not localize}
  2038. FReplyTexts.Add(503, 'program fault - command not performed'); {do not localize}
  2039. FReplyTexts.Add(580, 'Security layer already active'); {do not localize}
  2040. end;
  2041. function TIdNNTPServer.AuthRequired(ASender: TIdCommand): Boolean;
  2042. var
  2043. LContext: TIdNNTPContext;
  2044. begin
  2045. LContext := TIdNNTPContext(ASender.Context);
  2046. Result := (FSupportedAuthTypes <> []) and Assigned(FOnAuth) and (not LContext.Authenticated);
  2047. if Result then begin
  2048. if Assigned(FOnAuthRequired) then begin
  2049. FOnAuthRequired(LContext, ASender.CommandHandler.Command, ASender.UnparsedParams, Result);
  2050. end;
  2051. if Result then begin
  2052. { RLebeau - AUTHINFO SIMPLE is discouraged by RFC 2980, but it
  2053. is not completely obsolete, so if the user really wants to use
  2054. just it and no other, then do so here. If any other auth type
  2055. is begin supported though, always use another one instead }
  2056. if (FSupportedAuthTypes = [atSimple]) then begin
  2057. ASender.Reply.NumericCode := 450;
  2058. end else begin
  2059. ASender.Reply.NumericCode := 480;
  2060. end;
  2061. end;
  2062. end;
  2063. end;
  2064. function TIdNNTPServer.DoCheckMsgID(AContext: TIdNNTPContext; const AMsgID: String): Int64;
  2065. begin
  2066. Result := 0;
  2067. if Assigned(FOnCheckMsgId) then begin
  2068. FOnCheckMsgId(AContext, AMsgID, Result);
  2069. end;
  2070. end;
  2071. function TIdNNTPServer.DoCheckMsgNo(AContext: TIdNNTPContext; const AMsgNo: Int64): String;
  2072. begin
  2073. Result := '';
  2074. if Assigned(FOnCheckMsgNo) then begin
  2075. FOnCheckMsgNo(AContext, AMsgNo, Result);
  2076. end;
  2077. end;
  2078. function TIdNNTPServer.RawNavigate(AContext: TIdNNTPContext; AEvent: TIdNNTPOnMovePointer): String;
  2079. var
  2080. LMsgNo : Int64;
  2081. begin
  2082. Result := '';
  2083. LMsgNo := AContext.CurrentArticle;
  2084. if LMsgNo > 0 then begin
  2085. if Assigned(AEvent) then begin
  2086. AEvent(AContext, LMsgNo, Result);
  2087. end;
  2088. if (LMsgNo <> AContext.CurrentArticle) and (LMsgNo > 0) and (Result <> '') then begin {do not localize}
  2089. AContext.FCurrentArticle := LMsgNo;
  2090. end;
  2091. end;
  2092. end;
  2093. procedure TIdNNTPServer.SetHelp(AValue: TStrings);
  2094. begin
  2095. FHelp.Assign(AValue);
  2096. end;
  2097. procedure TIdNNTPServer.SetDistributionPatterns(AValue: TStrings);
  2098. begin
  2099. FDistributionPatterns.Assign(AValue);
  2100. end;
  2101. { TIdNNTPContext }
  2102. constructor TIdNNTPContext.Create(
  2103. AConnection: TIdTCPConnection;
  2104. AYarn: TIdYarn;
  2105. AList: TIdContextThreadList = nil
  2106. );
  2107. begin
  2108. inherited Create(AConnection, AYarn, AList);
  2109. FCurrentArticle := 0;
  2110. end;
  2111. procedure TIdNNTPContext.GenerateAuthEmail;
  2112. var
  2113. LIP, LHost: String;
  2114. LSocket: TIdIOHandlerSocket;
  2115. begin
  2116. FAuthEmail := ''; {do not localize}
  2117. if FUsername <> '' then begin {do not localize}
  2118. LSocket := Connection.Socket;
  2119. if Assigned(LSocket) then begin
  2120. if Assigned(LSocket.Binding) then begin
  2121. LIP := LSocket.Binding.PeerIP;
  2122. if LIP <> '' then begin {do not localize}
  2123. try
  2124. LHost := GStack.HostByAddress(LIP, LSocket.Binding.IPVersion);
  2125. except
  2126. LHost := ''; {do not localize}
  2127. end;
  2128. if LHost = '' then begin {do not localize}
  2129. LHost := LIP;
  2130. end;
  2131. FAuthEmail := FUsername + '@' + LHost; {do not localize}
  2132. end;
  2133. end;
  2134. end;
  2135. end;
  2136. end;
  2137. function TIdNNTPContext.GetUsingTLS: Boolean;
  2138. begin
  2139. Result := (Connection.IOHandler is TIdSSLIOHandlerSocketBase);
  2140. if Result then begin
  2141. Result := not TIdSSLIOHandlerSocketBase(Connection.IOHandler).PassThrough;
  2142. end;
  2143. end;
  2144. function TIdNNTPContext.GetCanUseExplicitTLS: Boolean;
  2145. begin
  2146. Result := (Connection.IOHandler is TIdSSLIOHandlerSocketBase);
  2147. if Result then begin
  2148. Result := (TIdNNTPServer(Server).UseTLS in ExplicitTLSVals);
  2149. end;
  2150. end;
  2151. function TIdNNTPContext.GetTLSIsRequired: Boolean;
  2152. begin
  2153. Result := (TIdNNTPServer(Server).UseTLS = utUseRequireTLS);
  2154. if Result then begin
  2155. Result := not UsingTLS;
  2156. end;
  2157. end;
  2158. procedure TIdNNTPServer.SetOverviewFormat(AValue: TStrings);
  2159. begin
  2160. FOverviewFormat.Assign(AValue);
  2161. end;
  2162. (*
  2163. 3.1 AUTHINFO
  2164. AUTHINFO is used to inform a server about the identity of a user of
  2165. the server. In all cases, clients must provide this information when
  2166. requested by the server. Servers are not required to accept
  2167. authentication information that is volunteered by the client.
  2168. Clients must accommodate servers that reject any authentication
  2169. information volunteered by the client.
  2170. There are three forms of AUTHINFO in use. The original version, an
  2171. NNTP v2 revision called AUTHINFO SIMPLE and a more recent version
  2172. which is called AUTHINFO GENERIC.
  2173. 3.1.1 Original AUTHINFO
  2174. AUTHINFO USER username
  2175. AUTHINFO PASS password
  2176. The original AUTHINFO is used to identify a specific entity to the
  2177. server using a simple username/password combination. It first
  2178. appeared in the UNIX reference implementation.
  2179. When authorization is required, the server will send a 480 response
  2180. requesting authorization from the client. The client must enter
  2181. AUTHINFO USER followed by the username. Once sent, the server will
  2182. cache the username and may send a 381 response requesting the
  2183. password associated with that username. Should the server request a
  2184. password using the 381 response, the client must enter AUTHINFO PASS
  2185. followed by a password and the server will then check the
  2186. authentication database to see if the username/password combination
  2187. is valid. If the combination is valid or if no password is required,
  2188. the server will return a 281 response. The client should then retry
  2189. the original command to which the server responded with the 480
  2190. response. The command should then be processed by the server
  2191. normally. If the combination is not valid, the server will return a
  2192. 502 response.
  2193. Clients must provide authentication when requested by the server. It
  2194. is possible that some implementations will accept authentication
  2195. information at the beginning of a session, but this was not the
  2196. original intent of the specification. If a client attempts to
  2197. reauthenticate, the server may return 482 response indicating that
  2198. the new authentication data is rejected by the server. The 482 code
  2199. will also be returned when the AUTHINFO commands are not entered in
  2200. the correct sequence (like two AUTHINFO USERs in a row, or AUTHINFO
  2201. PASS preceding AUTHINFO USER).
  2202. All information is passed in cleartext.
  2203. When authentication succeeds, the server will create an email address
  2204. for the client from the user name supplied in the AUTHINFO USER
  2205. command and the hostname generated by a reverse lookup on the IP
  2206. address of the client. If the reverse lookup fails, the IP address,
  2207. represented in dotted-quad format, will be used. Once authenticated,
  2208. the server shall generate a Sender: line using the email address
  2209. provided by authentication if it does not match the client-supplied
  2210. From: line. Additionally, the server should log the event, including
  2211. the email address. This will provide a means by which subsequent
  2212. statistics generation can associate newsgroup references with unique
  2213. entities - not necessarily by name.
  2214. 3.1.1.1 Responses
  2215. 281 Authentication accepted
  2216. 381 More authentication information required
  2217. 480 Authentication required
  2218. 482 Authentication rejected
  2219. 502 No permission
  2220. *)
  2221. procedure TIdNNTPServer.CommandAuthInfoPassword(ASender: TIdCommand);
  2222. var
  2223. LContext: TIdNNTPContext;
  2224. begin
  2225. if not SecLayerRequired(ASender) then begin
  2226. if (atUserPass in SupportedAuthTypes) and Assigned(FOnAuth) then begin
  2227. if ASender.Params.Count = 1 then begin
  2228. LContext := TIdNNTPContext(ASender.Context);
  2229. LContext.FAuthenticator := ''; {do not localize}
  2230. LContext.FAuthParams := ''; {do not localize}
  2231. LContext.FAuthEmail := ''; {do not localize}
  2232. LContext.FAuthType := atUserPass;
  2233. LContext.FPassword := ASender.Params[0];
  2234. FOnAuth(LContext, LContext.FAuthenticated);
  2235. if LContext.FAuthenticated then begin
  2236. LContext.GenerateAuthEmail;
  2237. ASender.Reply.NumericCode := 281;
  2238. end else begin
  2239. ASender.Reply.NumericCode := 482;
  2240. end;
  2241. end else begin
  2242. ASender.Reply.NumericCode := 482;
  2243. end;
  2244. end else begin
  2245. ASender.Reply.NumericCode := 500;
  2246. end;
  2247. end;
  2248. end;
  2249. procedure TIdNNTPServer.CommandAuthInfoUser(ASender: TIdCommand);
  2250. var
  2251. LContext: TIdNNTPContext;
  2252. begin
  2253. if not SecLayerRequired(ASender) then begin
  2254. if (atUserPass in SupportedAuthTypes) and Assigned(FOnAuth) then begin
  2255. if ASender.Params.Count = 1 then begin
  2256. LContext := TIdNNTPContext(ASender.Context);
  2257. LContext.FAuthenticator := ''; {do not localize}
  2258. LContext.FAuthParams := ''; {do not localize}
  2259. LContext.FAuthEmail := ''; {do not localize}
  2260. LContext.FAuthType := atUserPass;
  2261. LContext.FUsername := ASender.Params[0];
  2262. FOnAuth(LContext, LContext.FAuthenticated);
  2263. if LContext.FAuthenticated then begin
  2264. LContext.GenerateAuthEmail;
  2265. ASender.Reply.NumericCode := 281;
  2266. end else begin
  2267. ASender.Reply.NumericCode := 381;
  2268. end;
  2269. end else begin
  2270. ASender.Reply.NumericCode := 482;
  2271. end;
  2272. end else begin
  2273. ASender.Reply.NumericCode := 500;
  2274. end;
  2275. end;
  2276. end;
  2277. (*
  2278. 3.1 AUTHINFO
  2279. 3.1.2 AUTHINFO SIMPLE
  2280. AUTHINFO SIMPLE
  2281. user password
  2282. This version of AUTHINFO was part of a proposed NNTP V2
  2283. specification, which was started in 1991 but never completed, and is
  2284. implemented in some servers and clients. It is a refinement of the
  2285. original AUTHINFO and provides the same basic functionality, but the
  2286. sequence of commands is much simpler.
  2287. When authorization is required, the server sends a 450 response
  2288. requesting authorization from the client. The client must enter
  2289. AUTHINFO SIMPLE. If the server will accept this form of
  2290. authentication, the server responds with a 350 response. The client
  2291. must then send the username followed by one or more space characters
  2292. followed by the password. If accepted, the server returns a 250
  2293. response and the client should then retry the original command to
  2294. which the server responded with the 450 response. The command should
  2295. then be processed by the server normally. If the combination is not
  2296. valid, the server will return a 452 response.
  2297. Note that the response codes used here were part of the proposed NNTP
  2298. V2 specification and are violations of RFC 977. It is recommended
  2299. that this command not be implemented, but use either or both of the
  2300. other forms of AUTHINFO if such functionality if required.
  2301. 3.1.2.1 Responses
  2302. 250 Authorization accepted
  2303. 350 Continue with authorization sequence
  2304. 450 Authorization required for this command
  2305. 452 Authorization rejected
  2306. *)
  2307. procedure TIdNNTPServer.CommandAuthInfoSimple(ASender: TIdCommand);
  2308. var
  2309. s: String;
  2310. LReply: TIdReplyRFC;
  2311. LContext: TIdNNTPContext;
  2312. begin
  2313. if (atSimple in SupportedAuthTypes) and Assigned(FOnAuth) then begin
  2314. LContext := TIdNNTPContext(ASender.Context);
  2315. LReply := TIdReplyRFC.Create(nil);
  2316. try
  2317. LReply.NumericCode := 350;
  2318. ReplyTexts.UpdateText(LReply);
  2319. LContext.Connection.IOHandler.Write(LReply.FormattedReply);
  2320. finally
  2321. FreeAndNil(LReply);
  2322. end;
  2323. s := LContext.Connection.IOHandler.ReadLn;
  2324. LContext.FAuthenticator := ''; {do not localize}
  2325. LContext.FAuthParams := ''; {do not localize}
  2326. LContext.FAuthEmail := ''; {do not localize}
  2327. LContext.FAuthType := atSimple;
  2328. LContext.FUsername := Fetch(s);
  2329. LContext.FPassword := Trim(s);
  2330. FOnAuth(LContext, LContext.FAuthenticated);
  2331. if LContext.FAuthenticated then begin
  2332. LContext.GenerateAuthEmail;
  2333. ASender.Reply.NumericCode := 250;
  2334. end else begin
  2335. ASender.Reply.NumericCode := 452;
  2336. end;
  2337. end else begin
  2338. ASender.Reply.NumericCode := 500;
  2339. end;
  2340. end;
  2341. (*
  2342. 3.1 AUTHINFO
  2343. 3.1.3 AUTHINFO GENERIC
  2344. AUTHINFO GENERIC authenticator arguments...
  2345. AUTHINFO GENERIC is used to identify a specific entity to the server
  2346. using arbitrary authentication or identification protocols. The
  2347. desired protocol is indicated by the authenticator parameter, and any
  2348. number of parameters can be passed to the authenticator.
  2349. When authorization is required, the server will send a 480 response
  2350. requesting authorization from the client. The client should enter
  2351. AUTHINFO GENERIC followed by the authenticator name, and the
  2352. arguments if any. The authenticator and arguments must not contain
  2353. the sequence "..".
  2354. The server will attempt to engage the server end authenticator,
  2355. similarly, the client should engage the client end authenticator.
  2356. The server end authenticator will then initiate authentication using
  2357. the NNTP sockets (if appropriate for that authentication protocol),
  2358. using the protocol specified by the authenticator name. These
  2359. authentication protocols are not included in this document, but are
  2360. similar in structure to those referenced in RFC 1731 [8] for the
  2361. IMAP-4 protocol.
  2362. If the server returns 501, this means that the authenticator
  2363. invocation was syntactically incorrect, or that AUTHINFO GENERIC is
  2364. not supported. The client should retry using the AUTHINFO USER
  2365. command.
  2366. If the requested authenticator capability is not found, the server
  2367. returns the 503 response code.
  2368. If there is some other unspecified server program error, the server
  2369. returns the 500 response code.
  2370. The authenticators converse using their protocol until complete. If
  2371. the authentication succeeds, the server authenticator will terminate
  2372. with a 281, and the client can continue by reissuing the command that
  2373. prompted the 380. If the authentication fails, the server will
  2374. respond with a 502.
  2375. The client must provide authentication when requested by the server.
  2376. The server may request authentication at any time. Servers may
  2377. request authentication more than once during a single session.
  2378. When the server authenticator completes, it provides to the server
  2379. (by a mechanism herein undefined) the email address of the user, and
  2380. potentially what the user is allowed to access. Once authenticated,
  2381. the server shall generate a Sender: line using the email address
  2382. provided by the authenticator if it does not match the user-supplied
  2383. From: line. Additionally, the server should log the event, including
  2384. the user's authenticated email address (if available). This will
  2385. provide a means by which subsequent statistics generation can
  2386. associate newsgroup references with unique entities - not necessarily
  2387. by name.
  2388. Some implementations make it possible to obtain a list of
  2389. authentication procedures available by sending the server AUTHINFO
  2390. GENERIC with no arguments. The server then returns a list of
  2391. supported mechanisms followed by a period on a line by itself.
  2392. 3.1.3.1 Responses
  2393. 281 Authentication succeeded
  2394. 480 Authentication required
  2395. 500 Command not understood
  2396. 501 Command not supported
  2397. 502 No permission
  2398. 503 Program error, function not performed
  2399. nnn authenticator-specific protocol.
  2400. *)
  2401. procedure TIdNNTPServer.CommandAuthInfoGeneric(ASender: TIdCommand);
  2402. var
  2403. LContext: TIdNNTPContext;
  2404. s: String;
  2405. begin
  2406. if (atGeneric in SupportedAuthTypes) and Assigned(FOnAuth) then begin
  2407. s := Trim(ASender.UnparsedParams);
  2408. if (Length(s) > 0) and (IndyPos('..', s) = 0) then begin
  2409. LContext := TIdNNTPContext(ASender.Context);
  2410. LContext.FAuthenticator := Fetch(s);
  2411. LContext.FAuthParams := Trim(s);
  2412. LContext.FAuthEmail := ''; {do not localize}
  2413. LContext.FAuthType := atGeneric;
  2414. LContext.FUsername := ''; {do not localize}
  2415. LContext.FPassword := ''; {do not localize}
  2416. FOnAuth(LContext, LContext.FAuthenticated);
  2417. if LContext.FAuthenticated then begin
  2418. LContext.GenerateAuthEmail;
  2419. ASender.Reply.NumericCode := 281;
  2420. end else begin
  2421. ASender.Reply.NumericCode := 502;
  2422. end;
  2423. end else begin
  2424. ASender.Reply.NumericCode := 501;
  2425. end;
  2426. end else begin
  2427. ASender.Reply.NumericCode := 500;
  2428. end;
  2429. end;
  2430. function TIdNNTPServer.SecLayerRequired(ASender: TIdCommand): Boolean;
  2431. begin
  2432. Result := TIdNNTPContext(ASender.Context).TLSIsRequired;
  2433. if Result then begin
  2434. ASender.Reply.NumericCode := 483;
  2435. end;
  2436. end;
  2437. function TIdNNTPServer.LookupMessage(ASender: TIdCommand; var VNo: Int64; var VId: string): TIdNNTPLookupType;
  2438. var
  2439. s : string;
  2440. LContext : TidNNTPContext;
  2441. LIsMsgID: Boolean;
  2442. begin
  2443. Result := ltLookupError;
  2444. LContext := TIdNNTPContext(ASender.Context);
  2445. s := Trim(ASender.UnparsedParams);
  2446. VId := ''; {do not localize}
  2447. LIsMsgID := TextStartsWith(s, '<');
  2448. if not LIsMsgID then begin
  2449. if Length(LContext.CurrentGroup) = 0 then begin
  2450. ASender.Reply.NumericCode := 412; // No newsgroup has been selected
  2451. Exit;
  2452. end;
  2453. end;
  2454. if LIsMsgID then begin
  2455. VNo := DoCheckMsgID(LContext, s);
  2456. if VNo <= 0 then begin
  2457. ASender.Reply.NumericCode := 430; // Article not found
  2458. Exit;
  2459. end;
  2460. VId := s;
  2461. Result := ltLookupByMsgId;
  2462. {
  2463. RLebeau - per RFC 977, the CurrentArticle should
  2464. not be updated when selecting an article by MsgID
  2465. }
  2466. end
  2467. else begin
  2468. if Length(s) = 0 then begin
  2469. VNo := LContext.CurrentArticle;
  2470. if VNo <= 0 then begin
  2471. ASender.Reply.NumericCode := 420; // Current article not set.
  2472. Exit;
  2473. end;
  2474. end
  2475. else begin
  2476. VNo := IndyStrToInt64(s, 0);
  2477. if VNo > 0 then begin
  2478. VId := DoCheckMsgNo(LContext, VNo);
  2479. end;
  2480. if Length(VId) = 0 then begin
  2481. ASender.Reply.NumericCode := 423; // Article does not exist
  2482. Exit;
  2483. end;
  2484. LContext.FCurrentArticle := VNo;
  2485. end;
  2486. Result := ltLookupByMsgNo;
  2487. end;
  2488. end;
  2489. function TIdNNTPServer.LookupMessageRange(ASender: TIdCommand; const AData: String;
  2490. var VMsgFirst: Int64; var VMsgLast: Int64): Boolean;
  2491. var
  2492. s: String;
  2493. LContext: TIdNNTPContext;
  2494. IsRange: Boolean;
  2495. begin
  2496. Result := False;
  2497. LContext := TIdNNTPContext(ASender.Context);
  2498. if Length(LContext.CurrentGroup) = 0 then begin
  2499. ASender.Reply.NumericCode := 412;
  2500. Exit;
  2501. end;
  2502. s := Trim(AData);
  2503. if Length(s) = 0 then begin
  2504. IsRange := False;
  2505. VMsgFirst := LContext.CurrentArticle;
  2506. end else begin
  2507. IsRange := IndyPos('-', s) > 1;
  2508. if IsRange then begin
  2509. VMsgFirst := IndyStrToInt64(Fetch(s, '-'), 0);
  2510. end else begin
  2511. VMsgFirst := IndyStrToInt64(s, 0);
  2512. end;
  2513. end;
  2514. if VMsgFirst <= 0 then begin
  2515. ASender.Reply.NumericCode := 420;
  2516. Exit;
  2517. end;
  2518. if IsRange then begin
  2519. s := Trim(s);
  2520. if Length(s) = 0 then begin
  2521. VMsgLast := 0; // return all from VMsgFirst onwards
  2522. end else begin
  2523. VMsgLast := IndyStrToInt64(s, 0);
  2524. if VMsgLast < VMsgFirst then begin
  2525. ASender.Reply.NumericCode := 501;
  2526. Exit;
  2527. end;
  2528. end;
  2529. end else begin
  2530. VMsgLast := VMsgFirst;
  2531. end;
  2532. Result := True;
  2533. end;
  2534. function TIdNNTPServer.LookupMessageRangeOrID(ASender: TIdCommand; const AData: String;
  2535. var VMsgFirst: Int64; var VMsgLast: Int64; var VMsgID: String): Boolean;
  2536. var
  2537. s: String;
  2538. LFirstMsg: Int64;
  2539. LContext: TIdNNTPContext;
  2540. begin
  2541. Result := False;
  2542. LContext := TIdNNTPContext(ASender.Context);
  2543. s := Trim(AData);
  2544. if TextStartsWith(s, '<') then begin
  2545. LFirstMsg := DoCheckMsgID(LContext, s);
  2546. if LFirstMsg <= 0 then begin
  2547. ASender.Reply.NumericCode := 430;
  2548. Exit;
  2549. end;
  2550. VMsgFirst := LFirstMsg;
  2551. VMsgLast := LFirstMsg;
  2552. VMsgID := s;
  2553. Result := True;
  2554. end else begin
  2555. Result := LookupMessageRange(ASender, s, VMsgFirst, VMsgLast);
  2556. end;
  2557. end;
  2558. end.