units/indy/IdNNTPServer.pas

   1 // 28-nov-2002
   2 unit IdNNTPServer;
   3
   4 interface
   5
   6 uses KOL { ,
   7   Classes } ,
   8   IdGlobal,
   9   IdTCPServer;
  10
  11 const
  12   KnownCommands: array[1..26] of string =
  13   ('ARTICLE',
  14     'BODY',
  15     'HEAD',
  16     'STAT',
  17     'GROUP',
  18     'LIST',
  19     'HELP',
  20     'IHAVE',
  21     'LAST',
  22     'NEWGROUPS',
  23     'NEWNEWS',
  24     'NEXT',
  25     'POST',
  26     'QUIT',
  27     'SLAVE',
  28     'AUTHINFO',
  29     'XOVER',
  30     'XHDR',
  31     'DATE', {returns "111 YYYYMMDDHHNNSS"}
  32     'LISTGROUP', {returns all the article numbers for specified group}
  33     'MODE', {for the MODE command}
  34     'TAKETHIS', {streaming nntp}
  35     'CHECK', {streaming nntp need this to go with takethis}
  36     'XTHREAD', {Useful mainly for the TRN newsreader }
  37     'XGTITLE', {legacy support}
  38     'XPAT' {Header Pattern matching}
  39     );
  40
  41 type
  42   TGetEvent = procedure(AThread: TIdPeerThread) of object;
  43   TOtherEvent = procedure(AThread: TIdPeerThread; ACommand: string; AParm:
  44     string; var AHandled: Boolean) of object;
  45   TDoByIDEvent = procedure(AThread: TIdPeerThread; AActualID: string) of object;
  46   TDoByNoEvent = procedure(AThread: TIdPeerThread; AActualNumber: Cardinal) of
  47     object;
  48   TGroupEvent = procedure(AThread: TIdPeerThread; AGroup: string) of object;
  49   TNewsEvent = procedure(AThread: TIdPeerThread; AParm: string) of object;
  50   TDataEvent = procedure(AThread: TIdPeerThread; AData: TObject) of object;
  51
  52   TIdNNTPServer = object(TIdTCPServer)
  53   protected
  54     fOnCommandAuthInfo: TOtherEvent;
  55     fOnCommandArticleID: TDoByIDEvent;
  56     fOnCommandArticleNO: TDoByNoEvent;
  57     fOnCommandBodyID: TDoByIDEvent;
  58     fOnCommandBodyNO: TDoByNoEvent;
  59     fOnCommandHeadID: TDoByIDEvent;
  60     fOnCommandHeadNO: TDoByNoEvent;
  61     fOnCommandStatID: TDoByIDEvent;
  62     fOnCommandStatNO: TDoByNoEvent;
  63     fOnCommandGroup: TGroupEvent;
  64     fOnCommandList: TNewsEvent;
  65     fOnCommandHelp: TGetEvent;
  66     fOnCommandIHave: TDoByIDEvent;
  67     fOnCommandLast: TGetEvent;
  68     fOnCommandMode: TNewsEvent;
  69     fOnCommandNewGroups: TNewsEvent;
  70     fOnCommandNewNews: TNewsEvent;
  71     fOnCommandNext: TGetEvent;
  72     fOnCommandPost: TGetEvent;
  73     fOnCommandQuit: TGetEvent;
  74     fOnCommandSlave: TGetEvent;
  75
  76     fOnCommandXOver: TNewsEvent;
  77     fOnCommandXHDR: TNewsEvent;
  78     fOnCommandDate: TGetEvent;
  79     fOnCommandListgroup: TNewsEvent;
  80     fOnCommandTakeThis: TDoByIDEvent;
  81     fOnCommandCheck: TDoByIDEvent;
  82     fOnCommandXThread: TNewsEvent;
  83     fOnCommandXGTitle: TNewsEvent;
  84     fOnCommandXPat: TNewsEvent;
  85
  86     fOnCommandOther: TOtherEvent;
  87     //
  88     function DoExecute(AThread: TIdPeerThread): boolean; virtual;// override;
  89   public
  90 //    constructor Create(AOwner: TComponent); override;
  91 //  published
  92     property OnCommandAuthInfo: TOtherEvent read fOnCommandAuthInfo write
  93       fOnCommandAuthInfo;
  94     property OnCommandArticleID: TDoByIDEvent read fOnCommandArticleID write
  95       fOnCommandArticleID;
  96     property OnCommandArticleNo: TDoByNoEvent read fOnCommandArticleNo write
  97       fOnCommandArticleNo;
  98     property OnCommandBodyID: TDoByIDEvent read fOnCommandBodyID write
  99       fOnCommandBodyID;
 100     property OnCommandBodyNo: TDoByNoEvent read fOnCommandBodyNo write
 101       fOnCommandBodyNo;
 102     property OnCommandCheck: TDoByIDEvent read fOnCommandCheck write
 103       fOnCommandCheck;
 104     property OnCommandHeadID: TDoByIDEvent read fOnCommandHeadID write
 105       fOnCommandHeadID;
 106     property OnCommandHeadNo: TDoByNoEvent read fOnCommandHeadNo write
 107       fOnCommandHeadNo;
 108     property OnCommandStatID: TDoByIDEvent read fOnCommandStatID write
 109       fOnCommandStatID;
 110     property OnCommandStatNo: TDoByNoEvent read fOnCommandStatNo write
 111       fOnCommandStatNo;
 112     property OnCommandGroup: TGroupEvent read fOnCommandGroup write
 113       fOnCommandGroup;
 114     property OnCommandList: TNewsEvent read fOnCommandList write fOnCommandList;
 115     property OnCommandHelp: TGetEvent read fOnCommandHelp write fOnCommandHelp;
 116     property OnCommandIHave: TDoByIDEvent read fOnCommandIHave write
 117       fOnCommandIHave;
 118     property OnCommandLast: TGetEvent read fOnCommandLast write fOnCommandLast;
 119     property OnCommandMode: TNewsEvent read fOnCommandMode write fOnCommandMode;
 120     property OnCommandNewGroups: TNewsEvent read fOnCommandNewGroups write
 121       fOnCommandNewGroups;
 122     property OnCommandNewNews: TNewsEvent read fOnCommandNewNews write
 123       fOnCommandNewNews;
 124     property OnCommandNext: TGetEvent read fOnCommandNext write fOnCommandNext;
 125     property OnCommandPost: TGetEvent read fOnCommandPost write fOnCommandPost;
 126     property OnCommandQuit: TGetEvent read fOnCommandQuit write fOnCommandQuit;
 127     property OnCommandSlave: TGetEvent read fOnCommandSlave write
 128       fOnCommandSlave;
 129     property OnCommandTakeThis: TDoByIDEvent read fOnCommandTakeThis write
 130       fOnCommandTakeThis;
 131     property OnCommandXOver: TNewsEvent read fOnCommandXOver write
 132       fOnCommandXOver;
 133     property OnCommandXHDR: TNewsEvent read fOnCommandXHDR write fOnCommandXHDR;
 134     property OnCommandDate: TGetEvent read fOnCommandDate write fOnCommandDate;
 135     property OnCommandListgroup: TNewsEvent read fOnCommandListGroup write
 136       fOnCommandListGroup;
 137     property OnCommandXThread: TNewsEvent read fOnCommandXThread write
 138       fOnCommandXThread;
 139     property OnCommandXGTitle: TNewsEvent read fOnCommandXGTitle write
 140       fOnCommandXGTitle;
 141     property OnCommandXPat: TNewsEvent read fOnCommandXPat write fOnCommandXPat;
 142     property OnCommandOther: TOtherEvent read fOnCommandOther write
 143       fOnCommandOther;
 144     property DefaultPort default IdPORT_NNTP;
 145   end;
 146
 147 PIdNNTPServer=^TIdNNTPServer;
 148 function NewIdNNTPServer(AOwner: PControl):PIdNNTPServer;
 149
 150 implementation
 151
 152 uses {KOL,}
 153   IdTCPConnection,
 154   IdResourceStrings,
 155   SysUtils;
 156
 157  { constructor TIdNNTPServer.Create(AOwner: TComponent);
 158  }
 159 function NewIdNNTPServer (AOwner: PControl):PIdNNTPServer;
 160 begin
 161   New( Result, Create );
 162 with Result^ do
 163 begin
 164 //  inherited Create(AOwner);
 165 //  DefaultPort := IdPORT_NNTP;
 166 end;
 167 end;
 168
 169 function TIdNNTPServer.DoExecute(AThread: TIdPeerThread): boolean;
 170 var
 171   i: integer;
 172   s, sCmd: string;
 173   WasHandled: Boolean;
 174
 175   procedure NotHandled(CMD: string);
 176   begin
 177     AThread.Connection.Writeln('500 ' + Format(RSNNTPServerNotRecognized,
 178       [CMD]));
 179   end;
 180
 181   function isNumericString(Str: string): Boolean;
 182   begin
 183     if Length(str) = 0 then
 184       Result := False
 185     else
 186       Result := IsNumeric(Str[1]);
 187   end;
 188
 189 begin
 190   result := true;
 191
 192   with AThread.Connection do
 193   begin
 194     while Connected do
 195     begin
 196       try
 197         s := ReadLn;
 198       except
 199         exit;
 200       end;
 201
 202       sCmd := Fetch(s, ' ');
 203       i := Succ(PosInStrArray(UpperCase(sCmd), KnownCommands));
 204       case i of
 205         1: {article}
 206           if isNumericString(s) then
 207           begin
 208             if Assigned(OnCommandArticleNo) then
 209               OnCommandArticleNo(AThread, StrToCard(S))
 210             else
 211               NotHandled(sCmd);
 212           end
 213           else
 214           begin
 215             if Assigned(OnCommandArticleID) then
 216               OnCommandArticleID(AThread, S)
 217             else
 218               NotHandled(sCmd);
 219           end;
 220         2: {body}
 221           if isNumericString(s) then
 222           begin
 223             if assigned(OnCommandBodyNo) then
 224               OnCommandBodyNo(AThread, StrToCard(S))
 225             else
 226               NotHandled(sCmd);
 227           end
 228           else
 229           begin
 230             if assigned(OnCommandBodyID) then
 231               OnCommandBodyID(AThread, S)
 232             else
 233               NotHandled(sCmd);
 234           end;
 235         3: {head}
 236           if isNumericString(s) then
 237           begin
 238             if assigned(OnCommandHeadNo) then
 239               OnCommandHeadNo(AThread, StrToCard(S))
 240             else
 241               NotHandled(sCmd);
 242           end
 243           else
 244           begin
 245             if assigned(OnCommandHeadID) then
 246               OnCommandHeadID(AThread, S)
 247             else
 248               NotHandled(sCmd);
 249           end;
 250         4: {stat}
 251           if isNumericString(s) then
 252           begin
 253             if assigned(OnCommandStatNo) then
 254               OnCommandStatNo(AThread, StrToCard(S))
 255             else
 256               NotHandled(sCmd);
 257           end
 258           else
 259           begin
 260             if assigned(OnCommandStatID) then
 261               OnCommandStatID(AThread, S)
 262             else
 263               NotHandled(sCmd);
 264           end;
 265         5: {group}
 266           if assigned(OnCommandGroup) then
 267             OnCommandGroup(AThread, S)
 268           else
 269             NotHandled(sCmd);
 270         6: {list}
 271           if assigned(OnCommandList) then
 272             OnCommandList(AThread, S)
 273           else
 274             NotHandled(sCmd);
 275         7: {help}
 276           if assigned(OnCommandHelp) then
 277             OnCommandHelp(AThread)
 278           else
 279             NotHandled(sCmd);
 280         8: {ihave}
 281           if assigned(OnCommandIHave) then
 282             OnCommandIHave(AThread, S)
 283           else
 284             NotHandled(sCmd);
 285         9: {last}
 286           if assigned(OnCommandLast) then
 287             OnCommandLast(AThread)
 288           else
 289             NotHandled(sCmd);
 290         10: {newgroups}
 291           if assigned(OnCommandNewGroups) then
 292             OnCommandNewGroups(AThread, S)
 293           else
 294             NotHandled(sCmd);
 295         11: {newsgroups}
 296           if assigned(OnCommandNewNews) then
 297             OnCommandNewNews(AThread, S)
 298           else
 299             NotHandled(sCmd);
 300         12: {next}
 301           if assigned(OnCommandNext) then
 302             OnCommandNext(AThread)
 303           else
 304             NotHandled(sCmd);
 305         13: {post}
 306           if assigned(OnCommandPost) then
 307             OnCommandPost(AThread)
 308           else
 309             NotHandled(sCmd);
 310         14: {quit}
 311           begin
 312             if assigned(OnCommandQuit) then
 313               OnCommandQuit(AThread)
 314             else
 315               AThread.Connection.WriteLn('205 ' + RSNNTPServerGoodBye);
 316             AThread.Connection.Disconnect;
 317           end;
 318         15: {slave}
 319           if assigned(OnCommandSlave) then
 320             OnCommandSlave(AThread)
 321           else
 322             NotHandled(sCmd);
 323         16: {authinfo}
 324           if assigned(OnCommandAuthInfo) then
 325           begin
 326             sCmd := UpperCase(Fetch(s, ' '));
 327             WasHandled := False;
 328             OnCommandAuthInfo(AThread, SCmd, S, WasHandled);
 329             if not WasHandled then NotHandled(sCmd);
 330           end
 331           else
 332             NotHandled(sCmd);
 333         17: {xover}
 334           if assigned(OnCommandXOver) then
 335             OnCommandXOver(AThread, S)
 336           else
 337             NotHandled(sCmd);
 338         18: {xhdr}
 339           if assigned(OnCommandXHDR) then
 340             OnCommandXHDR(AThread, S)
 341           else
 342             NotHandled(sCmd);
 343         19: {date}
 344           if assigned(OnCommandDate) then
 345             OnCommandDate(AThread)
 346           else
 347             NotHandled(sCmd);
 348         20: {listgroup}
 349           if assigned(OnCommandListGroup) then
 350             OnCommandListGroup(AThread, S)
 351           else
 352             NotHandled(sCmd);
 353         21: {mode}
 354           if assigned(OnCommandMode) then
 355             OnCommandMode(AThread, S)
 356           else
 357             NotHandled(sCmd);
 358         22: {takethis}
 359           if assigned(OnCommandTakeThis) then
 360             OnCommandTakeThis(AThread, S)
 361           else
 362             NotHandled(sCmd);
 363         23: {check}
 364           if assigned(OnCommandCheck) then
 365             OnCommandCheck(AThread, S)
 366           else
 367             NotHandled(sCmd);
 368         24: {XThread}
 369           if assigned(OnCommandXThread) then
 370             OnCommandXThread(AThread, S)
 371           else
 372             NotHandled(sCmd);
 373         25: {XGTitle}
 374           if assigned(OnCommandXGTitle) then
 375             OnCommandXGTitle(AThread, S)
 376           else
 377             NotHandled(sCmd);
 378       else
 379         begin
 380           if assigned(OnCommandOther) then
 381           begin
 382             WasHandled := False;
 383             OnCommandOther(AThread, sCmd, S, WasHandled);
 384             if not WasHandled then NotHandled(sCmd);
 385           end
 386           else
 387             NotHandled(sCmd);
 388         end;
 389       end;
 390     end;
 391   end;
 392 end;
 393
 394 end.