aksdb
/
restemplate
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity
restemplate/indy/Protocols/IdReplyIMAP4.pas

516 lines
19 KiB
Plaintext
Raw Blame History

{
$Project$
$Workfile$
$Revision$
$DateUTC$
$Id$
This file is part of the Indy (Internet Direct) project, and is offered
under the dual-licensing agreement described on the Indy website.
(http://www.indyproject.org/)
Copyright:
(c) 1993-2005, Chad Z. Hower and the Indy Pit Crew. All rights reserved.
}
{
$Log$
}
{
Rev 1.26 3/23/2005 3:01:56 PM DSiders
Modified TIdReplyIMAP4.Destroy to call inherited destructor.
Rev 1.25 20/01/2005 11:02:00 CCostelloe
Now compiles, also updated to suit change in IdReply
Rev 1.24 1/19/05 5:21:52 PM RLebeau
added Destructor to free the FExtra object
Removed label from SetFormattedReply()
Rev 1.23 10/26/2004 10:39:54 PM JPMugaas
Updated refs.
Rev 1.22 6/11/2004 9:38:30 AM DSiders
Added "Do not Localize" comments.
Rev 1.21 5/17/04 9:53:00 AM RLebeau
Changed TIdRepliesIMAP4 constructor to use 'reintroduce' instead
Rev 1.20 5/16/04 5:31:24 PM RLebeau
Added constructor to TIdRepliesIMAP4 class
Rev 1.19 03/03/2004 01:16:56 CCostelloe
Yet another check-in as part of continuing development
Rev 1.18 26/02/2004 02:02:22 CCostelloe
A few updates to support IdIMAP4Server development
Rev 1.17 05/02/2004 00:26:06 CCostelloe
Changes to support TIdIMAP4Server
Rev 1.16 2/3/2004 4:12:34 PM JPMugaas
Fixed up units so they should compile.
Rev 1.15 2004.01.29 12:07:52 AM czhower
.Net constructor problem fix.
Rev 1.14 1/3/2004 8:05:48 PM JPMugaas
Bug fix: Sometimes, replies will appear twice due to the way functionality
was enherited.
Rev 1.13 22/12/2003 00:45:40 CCostelloe
.NET fixes
Rev 1.12 03/12/2003 09:48:34 CCostelloe
IsItANumber and IsItAValidSequenceNumber made public for use by TIdIMAP4.
Rev 1.11 28/11/2003 21:02:46 CCostelloe
Fixes for Courier IMAP
Rev 1.10 22/10/2003 12:18:06 CCostelloe
Split out DoesLineHaveExpectedResponse for use by other functions in IdIMAP4.
Rev 1.9 10/19/2003 5:57:12 PM DSiders
Added localization comments.
Rev 1.8 18/10/2003 22:33:00 CCostelloe
RemoveUnsolicitedResponses added.
Rev 1.7 20/09/2003 19:36:42 CCostelloe
Multiple changes to clear up older issues
Rev 1.6 2003.09.20 10:38:40 AM czhower
Bug fix to allow clearing code field (Return to default value)
Rev 1.5 18/06/2003 21:57:00 CCostelloe
Rewrote SetFormattedReply. Compiles and works. Needs tidying up, as does
IdIMAP4.
Rev 1.4 17/06/2003 01:38:12 CCostelloe
Updated to suit LoginSASL changes. Compiles OK.
Rev 1.3 15/06/2003 08:41:48 CCostelloe
Bug fix: i was undefined in SetFormattedReply in posted version, changed to LN
Rev 1.2 12/06/2003 10:26:14 CCostelloe
Unfinished but compiles. Checked in to show problem with Get/SetNumericCode.
Rev 1.1 6/5/2003 04:54:26 AM JPMugaas
Reworkings and minor changes for new Reply exception framework.
Rev 1.0 5/27/2003 03:03:54 AM JPMugaas
2003-Sep-26: CC2: Added Extra property.
2003-Oct-18: CC3: Added RemoveUnsolicitedResponses function.
2003-Nov-28: CC4: Fixes for Courier IMAP server.
}
unit IdReplyIMAP4;
interface
{$i IdCompilerDefines.inc}
uses
Classes,
IdReply,
IdReplyRFC;
const
IMAP_OK = 'OK'; {Do not Localize}
IMAP_NO = 'NO'; {Do not Localize}
IMAP_BAD = 'BAD'; {Do not Localize}
IMAP_PREAUTH = 'PREAUTH'; {Do not Localize}
IMAP_BYE = 'BYE'; {Do not Localize}
IMAP_CONT = '+'; {Do not Localize}
VALID_TAGGEDREPLIES : array [0..5] of string =
(IMAP_OK, IMAP_NO, IMAP_BAD, IMAP_PREAUTH, IMAP_BYE, IMAP_CONT);
type
TIdReplyIMAP4 = class(TIdReply)
protected
{CC: A tagged IMAP response is 'C41 OK Completed', where C41 is the
command sequence number identifying the command you sent to get that
response. An untagged one is '* OK Bad parameter'. The codes are
the same, some just start with *.
FSequenceNumber is either a *, C41 or '' (if the response line starts with
a valid response code like OK)...}
FSequenceNumber: string;
{IMAP servers can send extra info after a command like "BAD Bad parameter".
Keep these for error messages (may be more than one).
Unsolicited responses from the server will also be put here.}
FExtra: TStrings;
function GetExtra: TStrings; //Added to get over .NET not calling TIdReplyIMAP4's constructor
{You would think that we need to override IdReply's Get/SetNumericCode
because they assume the code is like '32' whereas IMAP codes are text like
'OK' (when IdReply's StrToIntDef always returns 0), but Indy 10 has switched
from numeric codes to string codes (i.e. we use 'OK' and never a
numeric equivalent like 4).}
{function GetNumericCode: Integer;
procedure SetNumericCode(const AValue: Integer);}
{Get/SetFormattedReply need to be overriden for IMAP4}
function GetFormattedReply: TStrings; override;
procedure SetFormattedReply(const AValue: TStrings); override;
{CC: Need this also, otherwise the virtual one in IdReply uses
TIdReplyRFC.CheckIfCodeIsValid which will only convert numeric
codes like '22' to integer 22.}
function CheckIfCodeIsValid(const ACode: string): Boolean; override;
public
constructor CreateWithReplyTexts(
ACollection: TCollection = nil;
AReplyTexts: TIdReplies = nil
); override;
destructor Destroy; override;
procedure Clear; override;
//
//CLIENT-SIDE (TIdIMAP4) FUNCTIONS...
procedure RaiseReplyError; override;
procedure DoReplyError(ADescription: string; AnOffendingLine: string = ''); reintroduce;
procedure RemoveUnsolicitedResponses(AExpectedResponses: array of String);
function DoesLineHaveExpectedResponse(ALine: string; AExpectedResponses: array of string): Boolean;
{CC: The following decides if AValue is a valid command sequence number
like C41...}
function IsItAValidSequenceNumber(const AValue: string): Boolean;
//
//SERVER-SIDE (TIdIMAP4Server) FUNCTIONS...
function ParseRequest(ARequest: string): Boolean;
//
property NumericCode: Integer read GetNumericCode write SetNumericCode;
property Extra: TStrings read GetExtra;
property SequenceNumber: string read FSequenceNumber;
//
end;
TIdRepliesIMAP4 = class(TIdReplies)
public
constructor Create(AOwner: TPersistent); reintroduce;
end;
//This error method came from the POP3 Protocol reply exceptions
// SendCmd / GetResponse
EIdReplyIMAP4Error = class(EIdReplyError);
implementation
uses
IdGlobal, IdGlobalProtocols, SysUtils;
{ TIdReplyIMAP4 }
function TIdReplyIMAP4.ParseRequest(ARequest: string): Boolean;
begin
FSequenceNumber := Fetch(ARequest);
Result := IsItAValidSequenceNumber(FSequenceNumber);
end;
function TIdReplyIMAP4.GetExtra: TStrings;
begin
if not Assigned(FExtra) then begin
FExtra := TStringList.Create;
end;
Result := FExtra;
end;
constructor TIdReplyIMAP4.CreateWithReplyTexts(
ACollection: TCollection = nil;
AReplyTexts: TIdReplies = nil
);
begin
inherited CreateWithReplyTexts(ACollection, AReplyTexts);
FExtra := TStringList.Create;
Clear;
end;
destructor TIdReplyIMAP4.Destroy;
begin
FreeAndNil(FExtra);
inherited Destroy;
end;
procedure TIdReplyIMAP4.Clear;
begin
inherited Clear;
FSequenceNumber := '';
Extra.Clear;
end;
procedure TIdReplyIMAP4.RaiseReplyError;
begin
raise EIdReplyIMAP4Error.Create(Extra.Text); {do not localize}
end;
{CC: The following decides if AValue is a valid command sequence number like C41...}
function TIdReplyIMAP4.IsItAValidSequenceNumber(const AValue: string): Boolean;
begin
{CC: Cannot be a C or a digit on its own...}
{CC: Must start with a C...}
if (Length(AValue) >= 2) and CharEquals(AValue, 1, 'C') then begin
{CC: Check if other characters are digits...}
Result := IsNumeric(AValue, -1, 2);
end else begin
Result := False;
end;
end;
function TIdReplyIMAP4.CheckIfCodeIsValid(const ACode: string): Boolean;
var
LOrd : Integer;
begin
LOrd := PosInStrArray(ACode, VALID_TAGGEDREPLIES, False);
Result := (LOrd <> -1) or (Trim(ACode) = '');
end;
function TIdReplyIMAP4.GetFormattedReply: TStrings;
begin
{Used by TIdIMAP4Server to assemble a string reply from our fields...}
FFormattedReply.Clear;
Result := FFormattedReply;
end;
{CC: AValue may be in one of a few formats:
1) Many commands just give a simple result to the command issued:
C41 OK Completed
2) Some commands give you data first, then the result:
* LIST (\UnMarked) "/" INBOX
* LIST (\UnMarked) "/" Junk
* LIST (\UnMarked) "/" Junk/Subbox1
C42 OK Completed
3) Some responses have a result but * instead of a command number (like C42):
* OK CommuniGate Pro IMAP Server 3.5.7 ready
4) Some have neither a * nor command number, but start with a result:
+ Send the additional command text
or:
BAD Bad parameter
Because you may get data first, which you need to put into Text, you need to
accept all the above possibilities.
In this function, we can assume that the last line of AValues has previously been
identified (by GetResponse).
For the Text parameter, data lines are added with the starting * stripped off.
The last Text line is the response line (the OK, BAD, etc., line) with any *
and response (OK, BAD) stripped out - this is usually just Completed or the
error message.
Set FSequenceNumber to C41 for cases (1) and (2) above, * for case (3), and
empty '' for case 4. This tells the caller the context of the reply.
}
procedure TIdReplyIMAP4.SetFormattedReply(const AValue: TStrings);
var
LWord: string;
LPos: integer;
LBuf : String;
LN: integer;
LLine: string;
begin
Clear;
LWord := '';
if AValue.Count <= 0 then begin
{Throw an exception. Something is badly messed up if we were called with
an empty string list.}
DoReplyError('Unexpected: Logic error, SetFormattedReply called with an empty list of parameters'); {do not localize}
end;
{CC: Any lines before the last one should be data lines, which begin with a * ...}
for LN := 0 to AValue.Count - 2 do begin
LLine := AValue[LN];
if LLine <> '' then begin
LWord := Trim(Fetch(LLine));
LLine := Trim(LLine);
if (LLine = '') then begin
{Throw an exception: this line is a single word, not a valid data
line since it does not have a * plus at least one word of data.}
DoReplyError('Unexpected: Non-last response line (i.e. a data line) only contained one word, instead of a * followed by one or more words', AValue[LN]); {do not localize}
end;
if (LWord <> '*') then begin {Do not Localize}
//Throw an exception: No * as first word of a data line.
DoReplyError('Unexpected: Non-last response line (i.e. a data line) did not start with a *', AValue[LN]); {do not localize}
end;
Text.Add(LLine);
end;
end;
{The response (OK, BAD, etc.) is in the LAST line received (or else the
function that got the response, such as GetResponse, is broken).}
LLine := AValue[AValue.Count-1];
if LLine = '' then begin
{Throw an exception: The previous function (GetResponse, or whatever)
messed up and passed an empty line as the response (last) line...}
DoReplyError('Unexpected: Response (last) line was empty instead of containing a line with a response code like OK, NO, BAD, etc'); {do not localize}
end;
LBuf := LLine;
LWord := Trim(Fetch(LBuf));
LBuf := Trim(LBuf);
{We can assume, if the previous function (GetResponse) did its
job, that either the first or the second word (if it exists) is the
response code...}
LPos := PosInStrArray(LWord, VALID_TAGGEDREPLIES); {Do not Localize}
if LPos > -1 then begin
{The first word is a valid response. Leave FSequenceNumber as ''
because there was nothing before it.}
FCode := LWord;
Text.Add(LBuf);
end
else if LWord = '*' then begin {Do not Localize}
if LBuf = '' then begin
{Throw an exception: it is a line that is just '*'}
DoReplyError('Unexpected: Response (last) line contained only a *'); {do not localize}
end;
FSequenceNumber := LWord; {Record that it is a * line}
{The next word had better be a response...}
LWord := Trim(Fetch(LBuf));
LBuf := Trim(LBuf);
if (LBuf = '') then begin
{Should never get to here: LBuf should have been ''. Might as
well throw an exception since we are down here anyway.}
DoReplyError('Unexpected: Response (last) line contained only a * (type 2)'); {do not localize}
end;
LPos := PosInStrArray(LWord, VALID_TAGGEDREPLIES);
if LPos = -1 then begin
{A line beginning with * but no valid response code as the 2nd
word. It is invalid, but maybe a data line that GetResponse
missed. Throw an exception anyway.}
DoReplyError('Unexpected: Response (last) line started with a * but next word was not a valid response like OK, BAD, etc', LLine); {do not localize}
end;
{A valid resonse code...}
FCode := LWord;
Text.Add(LBuf);
end
else if IsItAValidSequenceNumber(LWord) then begin
if LBuf = '' then begin
{Throw an exception: it is a line that is just 'C41' or whatever}
DoReplyError('Unexpected: Response (last) line started with a command reference (like C41) but nothing else', LLine); {do not localize}
end;
FSequenceNumber := LWord; {Record that it is a C41 line}
{The next word had better be a response...}
LWord := Trim(Fetch(LBuf));
LBuf := Trim(LBuf);
if LBuf = '' then begin
{Should never get to here: LBuf should have been ''. Might as
well throw an exception since we are down here anyway.}
DoReplyError('Unexpected: Logic error, line starts with a command reference (like C41) but nothing else, why was an exception not thrown earlier?', LLine); {do not localize}
end;
LPos := PosInStrArray(LWord, VALID_TAGGEDREPLIES);
if LPos = -1 then begin
{A line beginning with C41 but no valid response code as the 2nd
word. Throw an exception.}
DoReplyError('Unexpected: Line starts with a command reference (like C41) but next word was not a valid response like OK, BAD, etc', LLine); {do not localize}
end;
{A valid response code...}
FCode := LWord;
//CC4: LBuf will contain "SEARCH completed" if LLine was "C64 OK SEARCH completed".
//Ditch LBuf, otherwise we will confuse the later parser that checks for
//"expected response" keywords.
Extra.Add(LBuf);
end
else begin
{Not a response, * or command (e.g. C41). Throw an exception, as usual.}
DoReplyError('Unexpected: Line does not start with a command reference (like C41), a *, or a valid response like OK, BAD, etc', LLine); {do not localize}
end;
if FCode = '' then begin
{Did not get a valid response line, copy ALL of the last line we received
into Text[] for error display. This is paranoid programming, we probably
would have thrown an exception by now.}
Text.Add(AValue[AValue.Count-1]);
end;
end;
{CC3: This goes through the lines in Text and moves any that are not "expected" into
Extra. Lines that are "expected" are those that have a command in one of the
strings in AExpectedResponses, which has entries like "FETCH", "UID", "LIST".
Unsolicited responses are typically lines like "* RECENT 3", which are sent by
the server to tell you that new messages arrived. The problem is that they can
be anywhere in a reply from the server, the RFC does not stipulate where, or
what their format may be, but they wont be expected by the caller and will cause
the caller's parsing to fail.
The Text variable also has the bits stripped off from the final response, i.e.
it will have "Completed" as the last entry, stripped from "C62 OK Completed".}
procedure TIdReplyIMAP4.RemoveUnsolicitedResponses(AExpectedResponses: array of String);
var
LLine: string;
LN, LIndex: integer;
LLast: integer; {Need to calculate this outside the loop}
begin
{The (valid) lines are of one of two formats:
* LIST BlahBlah
* 53 FETCH BlahBlah
The "53" arises with commands that reference a specific email, the server returns
the relative message number in that case.
Note the * has been stripped off before this procedure is called.}
LLast := Text.Count-1;
LIndex := 0;
for LN := 0 to LLast do begin
LLine := Text[LIndex];
if LLine = '' then begin
{Unlikely to happen, but paranoia is always a better approach...}
Text.Delete(LIndex);
end
else begin
if DoesLineHaveExpectedResponse(LLine, AExpectedResponses) then begin
{We were expecting this word, so don't remove this line.}
Inc(LIndex);
Continue;
end;
{We were not expecting this response, it is an unsolicited response or
something else we are not interested in. Transfer the UNSTRIPPED
line to Extra (i.e. not LLine).}
Extra.Add(Text[LIndex]);
Text.Delete(LIndex);
end;
end;
end;
function TIdReplyIMAP4.DoesLineHaveExpectedResponse(ALine: string; AExpectedResponses: array of string): Boolean;
var
LWord: string;
LPos: integer;
begin
Result := False;
{Get the first word, it may be a relative message number like "53".
CC4: Note the line may only consist of a single word, e.g. "SEARCH" with some
servers (e.g. Courier) where there were no matches to the search.}
LPos := Pos(' ', ALine); {Do not Localize}
if LPos > 0 then begin
if IsNumeric(ALine, LPos-1) then begin
ALine := Copy(ALine, LPos+1, MaxInt);
end;
{If there was a relative message number, it is now stripped from LLine.}
{The first word in LLine is the one that may hold our expected response.}
LPos := Pos(' ', ALine); {Do not Localize}
if LPos > 0 then begin
LWord := Copy(ALine, 1, LPos-1);
end else begin
LWord := ALine;
end;
end else begin
LWord := ALine;
end;
if PosInStrArray(LWord, AExpectedResponses) > -1 then begin
{We were expecting this word...}
Result := True;
end;
end;
procedure TIdReplyIMAP4.DoReplyError(ADescription: string; AnOffendingLine: string);
var
LMsg: string;
begin
LMsg := ADescription;
if AnOffendingLine <> '' then begin
LMsg := LMsg + ', offending line: ' + AnOffendingLine; {do not localize}
end;
raise EIdReplyIMAP4Error.Create(LMsg);
end;
{ TIdRepliesIMAP4 }
constructor TIdRepliesIMAP4.Create(AOwner: TPersistent);
begin
inherited Create(AOwner, TIdReplyIMAP4);
end;
end.
Reference in New Issue View Git Blame Copy Permalink