Hi, I would like to share my modifications to Synapse's IMAP client.
The patch attached adds support for double quotes and backslashes in username, password, search strings and folder names according to RFC2683 section 3.4.2 "Special Characters", see https://tools.ietf.org/html/rfc2683#section-3.4.2 Kind regards, Dirk
Index: imapsend.pas =================================================================== --- imapsend.pas (revision 202) +++ imapsend.pas (working copy) @@ -224,6 +224,14 @@ {:Try to find given capabily in capabilty string returned from IMAP server.} function FindCap(const Value: string): string; + + {:Escapes characters that are not allowed to be sent to an IMAP server, see + RFC 2683 3.4.2. Special Characters} + function EscapeSpecialCharacters(Value:string): string; + + {:Undoes the escaping done with EscapeSpecialCharacters.} + function UnescapeSpecialCharacters(Value:string): string; + published {:Status line with result of last operation.} property ResultString: string read FResultString; @@ -393,6 +401,44 @@ Result := ReadResult; end; +function TIMAPSend.EscapeSpecialCharacters(Value:string): string; +var + i: Integer; +begin + Result := ''; + for i := 1 to length(Value) do + begin + // We need to escape double quotes and backslashes + if (Value[i] = '"') or (Value[i] = '\') then + begin + Result := Result + '\'; + end; + Result := Result + Value[i]; + end; +end; + +function TIMAPSend.UnescapeSpecialCharacters(Value:string): string; +var i, l: Integer; +begin + Result := ''; + i := 1; + l := length(Value); + while i <= l do + begin + // Search for escaped double quotes and backslashes + if (Value[i] = '\') and (i < l) and ((Value[i+1] = '"') or (Value[i+1] = '\')) then + begin + Result := Result + Value[i+1]; + Inc(i, 2); + end + else + begin + Result := Result + Value[i]; + Inc(i); + end; + end; +end; + procedure TIMAPSend.ParseMess(Value:TStrings); var n: integer; @@ -409,7 +455,8 @@ procedure TIMAPSend.ParseFolderList(Value:TStrings); var n, x: integer; - s: string; + folder, s: string; + quotes : boolean; begin ProcessLiterals; Value.Clear; @@ -418,15 +465,26 @@ s := FFullResult[n]; if (s <> '') and (Pos('\NOSELECT', UpperCase(s)) = 0) then begin - if s[Length(s)] = '"' then + // Does the string end with quotes? + quotes := s[Length(s)] = '"'; + if quotes then begin + // Remove ending quote and get starting position - 1 of string Delete(s, Length(s), 1); - x := RPos('"', s); + x := RPos(' "', s) + 1; end else + // get starting position - 1 of string x := RPos(' ', s); - if (x > 0) then - Value.Add(Copy(s, x + 1, Length(s) - x)); + if (x > 0) then begin + // Get folder name from starting position to end + folder := Copy(s, x + 1, Length(s) - x); + if quotes then begin + // we only need to unescape if the whole string was quoted + folder := UnescapeSpecialCharacters(folder); + end; + Value.Add(folder); + end; end; end; end; @@ -500,7 +558,7 @@ function TIMAPSend.AuthLogin: Boolean; begin - Result := IMAPcommand('LOGIN "' + FUsername + '" "' + FPassword + '"') = 'OK'; + Result := IMAPcommand('LOGIN "' + EscapeSpecialCharacters(FUsername) + '" "' + EscapeSpecialCharacters(FPassword) + '"') = 'OK'; if Result then FAuthDone := True; end; @@ -590,56 +648,56 @@ function TIMAPSend.List(FromFolder: string; const FolderList: TStrings): Boolean; begin - Result := IMAPcommand('LIST "' + FromFolder + '" *') = 'OK'; + Result := IMAPcommand('LIST "' + EscapeSpecialCharacters(FromFolder) + '" *') = 'OK'; ParseFolderList(FolderList); end; function TIMAPSend.ListSearch(FromFolder, Search: string; const FolderList: TStrings): Boolean; begin - Result := IMAPcommand('LIST "' + FromFolder + '" "' + Search +'"') = 'OK'; + Result := IMAPcommand('LIST "' + EscapeSpecialCharacters(FromFolder) + '" "' + EscapeSpecialCharacters(Search) +'"') = 'OK'; ParseFolderList(FolderList); end; function TIMAPSend.ListSubscribed(FromFolder: string; const FolderList: TStrings): Boolean; begin - Result := IMAPcommand('LSUB "' + FromFolder + '" *') = 'OK'; + Result := IMAPcommand('LSUB "' + EscapeSpecialCharacters(FromFolder) + '" *') = 'OK'; ParseFolderList(FolderList); end; function TIMAPSend.ListSearchSubscribed(FromFolder, Search: string; const FolderList: TStrings): Boolean; begin - Result := IMAPcommand('LSUB "' + FromFolder + '" "' + Search +'"') = 'OK'; + Result := IMAPcommand('LSUB "' + EscapeSpecialCharacters(FromFolder) + '" "' + EscapeSpecialCharacters(Search) +'"') = 'OK'; ParseFolderList(FolderList); end; function TIMAPSend.CreateFolder(FolderName: string): Boolean; begin - Result := IMAPcommand('CREATE "' + FolderName + '"') = 'OK'; + Result := IMAPcommand('CREATE "' + EscapeSpecialCharacters(FolderName) + '"') = 'OK'; end; function TIMAPSend.DeleteFolder(FolderName: string): Boolean; begin - Result := IMAPcommand('DELETE "' + FolderName + '"') = 'OK'; + Result := IMAPcommand('DELETE "' + EscapeSpecialCharacters(FolderName) + '"') = 'OK'; end; function TIMAPSend.RenameFolder(FolderName, NewFolderName: string): Boolean; begin - Result := IMAPcommand('RENAME "' + FolderName + '" "' + NewFolderName + '"') = 'OK'; + Result := IMAPcommand('RENAME "' + EscapeSpecialCharacters(FolderName) + '" "' + EscapeSpecialCharacters(NewFolderName) + '"') = 'OK'; end; function TIMAPSend.SubscribeFolder(FolderName: string): Boolean; begin - Result := IMAPcommand('SUBSCRIBE "' + FolderName + '"') = 'OK'; + Result := IMAPcommand('SUBSCRIBE "' + EscapeSpecialCharacters(FolderName) + '"') = 'OK'; end; function TIMAPSend.UnsubscribeFolder(FolderName: string): Boolean; begin - Result := IMAPcommand('UNSUBSCRIBE "' + FolderName + '"') = 'OK'; + Result := IMAPcommand('UNSUBSCRIBE "' + EscapeSpecialCharacters(FolderName) + '"') = 'OK'; end; function TIMAPSend.SelectFolder(FolderName: string): Boolean; begin - Result := IMAPcommand('SELECT "' + FolderName + '"') = 'OK'; + Result := IMAPcommand('SELECT "' + EscapeSpecialCharacters(FolderName) + '"') = 'OK'; FSelectedFolder := FolderName; ParseSelect; end; @@ -646,7 +704,7 @@ function TIMAPSend.SelectROFolder(FolderName: string): Boolean; begin - Result := IMAPcommand('EXAMINE "' + FolderName + '"') = 'OK'; + Result := IMAPcommand('EXAMINE "' + EscapeSpecialCharacters(FolderName) + '"') = 'OK'; FSelectedFolder := FolderName; ParseSelect; end; @@ -664,7 +722,7 @@ begin Result := -1; Value := Uppercase(Value); - if IMAPcommand('STATUS "' + FolderName + '" (' + Value + ')' ) = 'OK' then + if IMAPcommand('STATUS "' + EscapeSpecialCharacters(FolderName) + '" (' + Value + ')' ) = 'OK' then begin ProcessLiterals; for n := 0 to FFullResult.Count - 1 do @@ -695,7 +753,7 @@ function TIMAPSend.AppendMess(ToFolder: string; const Mess: TStrings): Boolean; begin - Result := IMAPuploadCommand('APPEND "' + ToFolder + '"', Mess) = 'OK'; + Result := IMAPuploadCommand('APPEND "' + EscapeSpecialCharacters(ToFolder) + '"', Mess) = 'OK'; end; function TIMAPSend.DeleteMess(MessID: integer): boolean; @@ -761,7 +819,7 @@ var s: string; begin - s := 'COPY ' + IntToStr(MessID) + ' "' + ToFolder + '"'; + s := 'COPY ' + IntToStr(MessID) + ' "' + EscapeSpecialCharacters(ToFolder) + '"'; if FUID then s := 'UID ' + s; Result := IMAPcommand(s) = 'OK';
_______________________________________________ synalist-public mailing list synalist-public@lists.sourceforge.net https://lists.sourceforge.net/lists/listinfo/synalist-public