IdMessageCoderMIME.pas 29 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740741742743744745746747748749750751752753754755756757758759760761762763764765766767768769770771772773774775776777778779780781782783784785786787788789790791792793794795796797798799800801802803804805806807
  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.37 26/03/2005 19:20:10 CCostelloe
  18. Fixes for "uneven size" exception
  19. Rev 1.36 27.08.2004 22:03:58 Andreas Hausladen
  20. speed optimization ("const" for string parameters)
  21. Rev 1.35 8/15/04 5:41:00 PM RLebeau
  22. Updated GetAttachmentFilename() to handle cases where Outlook puts spaces
  23. between "name=" and the filename.
  24. Updated CheckAndSetType() to retreive the filename before checking the type.
  25. This helps to detect all file attachments better, including "form-data"
  26. attachments
  27. Rev 1.34 8/11/04 1:32:52 AM RLebeau
  28. Bug fix for TIdMessageDecoderMIME.GetAttachmentFilename()
  29. Rev 1.33 8/10/04 1:41:48 PM RLebeau
  30. Misc. tweaks
  31. Rev 1.32 6/11/2004 9:38:22 AM DSiders
  32. Added "Do not Localize" comments.
  33. Rev 1.31 6/4/04 12:41:04 PM RLebeau
  34. ContentTransferEncoding bug fix
  35. Rev 1.30 29/05/2004 21:23:56 CCostelloe
  36. Added support for decoding attachments with a Content-Transfer-Encoding of
  37. binary
  38. Rev 1.29 2004.05.20 1:39:12 PM czhower
  39. Last of the IdStream updates
  40. Rev 1.28 2004.05.20 11:36:56 AM czhower
  41. IdStreamVCL
  42. Rev 1.27 2004.05.20 11:13:00 AM czhower
  43. More IdStream conversions
  44. Rev 1.26 2004.05.19 3:06:40 PM czhower
  45. IdStream / .NET fix
  46. Rev 1.25 16/05/2004 18:55:26 CCostelloe
  47. New TIdText/TIdAttachment processing
  48. Rev 1.24 23/04/2004 20:50:24 CCostelloe
  49. Paths removed from attachment filenames and invalid Windows filename chars
  50. weeded out
  51. Rev 1.23 04/04/2004 17:44:56 CCostelloe
  52. Bug fix
  53. Rev 1.22 03/04/2004 20:27:22 CCostelloe
  54. Fixed bug where code assumed Content-Type always contained a filename for the
  55. attachment.
  56. Rev 1.21 2004.02.03 5:44:04 PM czhower
  57. Name changes
  58. Rev 1.20 1/31/2004 3:12:48 AM JPMugaas
  59. Removed dependancy on Math unit. It isn't needed and is problematic in some
  60. versions of Dlephi which don't include it.
  61. Rev 1.19 1/22/2004 4:02:52 PM SPerry
  62. fixed set problems
  63. Rev 1.18 16/01/2004 17:42:56 CCostelloe
  64. Added support for BinHex 4.0 encoding
  65. Rev 1.17 5/12/2003 9:18:26 AM GGrieve
  66. use WriteStringToStream
  67. Rev 1.16 5/12/2003 12:31:16 AM GGrieve
  68. Fis WriteBuffer - can't be used in DotNet
  69. Rev 1.15 10/17/2003 12:40:20 AM DSiders
  70. Added localization comments.
  71. Rev 1.14 05/10/2003 16:41:54 CCostelloe
  72. Restructured MIME boundary outputting
  73. Rev 1.13 29/09/2003 13:07:48 CCostelloe
  74. Second RandomRange replaced with Random
  75. Rev 1.12 28/09/2003 22:56:30 CCostelloe
  76. TIdMessageEncoderInfoMIME.InitializeHeaders now only sets ContentType if it
  77. is ''
  78. Rev 1.11 28/09/2003 21:06:52 CCostelloe
  79. Recoded RandomRange to Random to suit D% and BCB5
  80. Rev 1.10 26/09/2003 01:05:42 CCostelloe
  81. Removed FIndyMultiPartAlternativeBoundary, IFndyMultiPartRelatedBoundary - no
  82. longer needed. Added support for ContentTransferEncoding '8bit'. Changed
  83. nested MIME decoding from finding boundary to finding 'multipart/'.
  84. Rev 1.9 04/09/2003 20:46:38 CCostelloe
  85. Added inclusion of =_ in boundary generation in
  86. TIdMIMEBoundaryStrings.GenerateStrings
  87. Rev 1.8 30/08/2003 18:39:58 CCostelloe
  88. MIME boundaries changed to be random strings
  89. Rev 1.7 07/08/2003 00:56:48 CCostelloe
  90. ReadBody altered to allow lines over 16K (arises with long html parts)
  91. Rev 1.6 2003.06.14 11:08:10 PM czhower
  92. AV fix
  93. Rev 1.5 6/14/2003 02:46:42 PM JPMugaas
  94. Kudzu wanted the BeginDecode called after LDecoder was created and EndDecode
  95. to be called just before LDecoder was destroyed.
  96. Rev 1.4 6/14/2003 1:14:12 PM BGooijen
  97. fix for the bug where the attachments are empty
  98. Rev 1.3 6/13/2003 07:58:46 AM JPMugaas
  99. Should now compile with new decoder design.
  100. Rev 1.2 5/23/03 11:24:06 AM RLebeau
  101. Fixed a compiler error for previous changes
  102. Rev 1.1 5/23/03 9:51:18 AM RLebeau
  103. Fixed bug where message body is parsed incorrectly when MIMEBoundary is empty.
  104. Rev 1.0 11/13/2002 07:57:08 AM JPMugaas
  105. 2003-Oct-04 Ciaran Costelloe
  106. Moved boundary out of InitializeHeaders into TIdMessage.GenerateHeader
  107. }
  108. unit IdMessageCoderMIME;
  109. // for all 3 to 4s:
  110. // TODO: Predict output sizes and presize outputs, then use move on
  111. // presized outputs when possible, or presize only and reposition if stream
  112. interface
  113. {$i IdCompilerDefines.inc}
  114. uses
  115. Classes,
  116. IdBaseComponent,
  117. IdMessageCoder,
  118. IdMessage,
  119. IdGlobal;
  120. type
  121. TIdMessageDecoderMIME = class(TIdMessageDecoder)
  122. protected
  123. FFirstLine: string;
  124. FProcessFirstLine: Boolean;
  125. FBodyEncoded: Boolean;
  126. FMIMEBoundary: string;
  127. function GetProperHeaderItem(const Line: string): string;
  128. public
  129. constructor Create(AOwner: TComponent); overload; override;
  130. constructor Create(AOwner: TComponent; const ALine: string); overload;
  131. function ReadBody(ADestStream: TStream; var VMsgEnd: Boolean): TIdMessageDecoder; override;
  132. procedure CheckAndSetType(const AContentType, AContentDisposition: string);
  133. procedure ReadHeader; override;
  134. function GetAttachmentFilename(const AContentType, AContentDisposition: string): string;
  135. function RemoveInvalidCharsFromFilename(const AFilename: string): string;
  136. //
  137. property MIMEBoundary: string read FMIMEBoundary write FMIMEBoundary;
  138. property BodyEncoded: Boolean read FBodyEncoded write FBodyEncoded;
  139. end;
  140. TIdMessageDecoderInfoMIME = class(TIdMessageDecoderInfo)
  141. public
  142. function CheckForStart(ASender: TIdMessage; const ALine: string): TIdMessageDecoder; override;
  143. end;
  144. TIdMessageEncoderMIME = class(TIdMessageEncoder)
  145. public
  146. procedure Encode(ASrc: TStream; ADest: TStream); override;
  147. end;
  148. TIdMessageEncoderInfoMIME = class(TIdMessageEncoderInfo)
  149. public
  150. constructor Create; override;
  151. procedure InitializeHeaders(AMsg: TIdMessage); override;
  152. end;
  153. TIdMIMEBoundaryStrings = class
  154. public
  155. class function GenerateRandomChar: Char;
  156. class function GenerateBoundary: String;
  157. end;
  158. TIdMIMEFilenamePathDelimiterAction = (actTruncatePath, actReplaceWithUnderscore);
  159. var
  160. DecodeFilenamePathDelimiterAction: TIdMIMEFilenamePathDelimiterAction = actReplaceWithUnderscore;
  161. implementation
  162. uses
  163. IdCoder, IdCoderMIME, IdGlobalProtocols,
  164. IdCoderQuotedPrintable, IdCoderBinHex4, IdCoderHeader, SysUtils;
  165. type
  166. {
  167. RLebeau: TIdMessageDecoderMIMEIgnore is a private class used when
  168. TIdMessageDecoderInfoMIME.CheckForStart() detects an ending MIME boundary
  169. for a finished message part that has nested parts in it. This is a dirty
  170. hack to allow TIdMessageClient to skip the boundary line properly, or else
  171. the line ends up as spare data in the TIdMessage.Body property, which is
  172. not desired. A better solution to signal TIdMessageClient to ignore the
  173. line needs to be found later.
  174. }
  175. TIdMessageDecoderMIMEIgnore = class(TIdMessageDecoder)
  176. public
  177. function ReadBody(ADestStream: TStream; var VMsgEnd: Boolean): TIdMessageDecoder; override;
  178. procedure ReadHeader; override;
  179. end;
  180. function TIdMessageDecoderMIMEIgnore.ReadBody(ADestStream: TStream; var VMsgEnd: Boolean): TIdMessageDecoder;
  181. begin
  182. VMsgEnd := False;
  183. Result := nil;
  184. end;
  185. procedure TIdMessageDecoderMIMEIgnore.ReadHeader;
  186. begin
  187. FPartType := mcptIgnore;
  188. end;
  189. { TIdMIMEBoundaryStrings }
  190. class function TIdMIMEBoundaryStrings.GenerateRandomChar: Char;
  191. var
  192. LOrd: integer;
  193. LFloat: Double;
  194. begin
  195. if RandSeed = 0 then begin
  196. Randomize;
  197. end;
  198. {Allow only digits (ASCII 48-57), upper-case letters (65-90) and lowercase
  199. letters (97-122), which is 62 possible chars...}
  200. LFloat := (Random * 61) + 1.5; //Gives us 1.5 to 62.5
  201. LOrd := Trunc(LFloat) + 47; //(1..62) -> (48..109)
  202. if LOrd > 83 then begin
  203. LOrd := LOrd + 13; {Move into lowercase letter range}
  204. end else if LOrd > 57 then begin
  205. Inc(LOrd, 7); {Move into upper-case letter range}
  206. end;
  207. Result := Chr(LOrd);
  208. end;
  209. {This generates a random MIME boundary.}
  210. class function TIdMIMEBoundaryStrings.GenerateBoundary: String;
  211. const
  212. {Generate a string 34 characters long (34 is a whim, not a requirement)...}
  213. BoundaryLength = 34;
  214. var
  215. LN: Integer;
  216. LFloat: Double;
  217. {$IFDEF STRING_IS_IMMUTABLE}
  218. LSB: TIdStringBuilder;
  219. {$ENDIF}
  220. begin
  221. {$IFDEF STRING_IS_IMMUTABLE}
  222. LSB := TIdStringBuilder.Create(BoundaryLength);
  223. {$ELSE}
  224. Result := StringOfChar(' ', BoundaryLength);
  225. {$ENDIF}
  226. for LN := 1 to BoundaryLength do begin
  227. {$IFDEF STRING_IS_IMMUTABLE}
  228. LSB.Append(GenerateRandomChar);
  229. {$ELSE}
  230. Result[LN] := GenerateRandomChar;
  231. {$ENDIF}
  232. end;
  233. {CC2: RFC 2045 recommends including "=_" in the boundary, insert in random location...}
  234. LFloat := (Random * (BoundaryLength-2)) + 1.5; //Gives us 1.5 to Length-0.5
  235. LN := Trunc(LFloat); // 1 to Length-1 (we are inserting a 2-char string)
  236. {$IFDEF STRING_IS_IMMUTABLE}
  237. LSB[LN-1] := '=';
  238. LSB[LN] := '_';
  239. Result := LSB.ToString;
  240. {$ELSE}
  241. Result[LN] := '=';
  242. Result[LN+1] := '_';
  243. {$ENDIF}
  244. end;
  245. { TIdMessageDecoderInfoMIME }
  246. function TIdMessageDecoderInfoMIME.CheckForStart(ASender: TIdMessage;
  247. const ALine: string): TIdMessageDecoder;
  248. var
  249. LContentTransferEncoding: string;
  250. begin
  251. Result := nil;
  252. if ASender.MIMEBoundary.Boundary <> '' then begin
  253. if TextIsSame(ALine, '--' + ASender.MIMEBoundary.Boundary) then begin {Do not Localize}
  254. Result := TIdMessageDecoderMIME.Create(ASender);
  255. end
  256. else if TextIsSame(ALine, '--' + ASender.MIMEBoundary.Boundary + '--') then begin {Do not Localize}
  257. ASender.MIMEBoundary.Pop;
  258. Result := TIdMessageDecoderMIMEIgnore.Create(ASender);
  259. end;
  260. end;
  261. if (Result = nil) and (ASender.ContentTransferEncoding <> '') then begin
  262. LContentTransferEncoding := ExtractHeaderItem(ASender.ContentTransferEncoding);
  263. if IsHeaderMediaType(ASender.ContentType, 'multipart') and {do not localize}
  264. (PosInStrArray(LContentTransferEncoding, ['7bit', '8bit', 'binary'], False) = -1) then {do not localize}
  265. begin
  266. Exit;
  267. end;
  268. if (PosInStrArray(LContentTransferEncoding, ['base64', 'quoted-printable'], False) <> -1) then begin {Do not localize}
  269. Result := TIdMessageDecoderMIME.Create(ASender, ALine);
  270. end;
  271. end;
  272. end;
  273. { TIdMessageDecoderMIME }
  274. constructor TIdMessageDecoderMIME.Create(AOwner: TComponent);
  275. var
  276. LMsg: TIdMessage;
  277. begin
  278. inherited Create(AOwner);
  279. FBodyEncoded := False;
  280. if AOwner is TIdMessage then begin
  281. LMsg := TIdMessage(AOwner);
  282. FMIMEBoundary := LMsg.MIMEBoundary.Boundary;
  283. {CC2: Check to see if this is an email of the type that is headers followed
  284. by the body encoded in base64 or quoted-printable. The problem with this type
  285. is that the header may state it as MIME, but the MIME parts and their headers
  286. will be encoded, so we won't find them - in this case, we will later take
  287. all the info we need from the message header, and not try to take it from
  288. the part header.}
  289. if LMsg.ContentTransferEncoding <> '' then begin
  290. // RLebeau 12/26/2014 - According to RFC 2045 Section 6.4:
  291. // "If an entity is of type "multipart" the Content-Transfer-Encoding is not
  292. // permitted to have any value other than "7bit", "8bit" or "binary"."
  293. //
  294. // However, came across one message where the "Content-Type" was set to
  295. // "multipart/related" and the "Content-Transfer-Encoding" was set to
  296. // "quoted-printable". Outlook and Thunderbird were apparently able to parse
  297. // the message correctly, but Indy was not. So let's check for that scenario
  298. // and ignore illegal "Content-Transfer-Encoding" values if present...
  299. if (not IsHeaderMediaType(LMsg.ContentType, 'multipart')) and
  300. {CC2: added 8bit below, changed to TextIsSame. Reason is that many emails
  301. set the Content-Transfer-Encoding to 8bit, have multiple parts, and display
  302. the part header in plain-text.}
  303. (not IsHeaderValue(LMsg.ContentTransferEncoding, ['8bit', '7bit', 'binary'])) {do not localize}
  304. then begin
  305. FBodyEncoded := True;
  306. end;
  307. end;
  308. end;
  309. end;
  310. constructor TIdMessageDecoderMIME.Create(AOwner: TComponent; const ALine: string);
  311. begin
  312. Create(AOwner);
  313. FFirstLine := ALine;
  314. FProcessFirstLine := True;
  315. end;
  316. function TIdMessageDecoderMIME.ReadBody(ADestStream: TStream; var VMsgEnd: Boolean): TIdMessageDecoder;
  317. var
  318. LContentType, LContentTransferEncoding: string;
  319. LDecoder: TIdDecoder;
  320. LLine: string;
  321. LBinaryLineBreak: string;
  322. LBuffer: string; //Needed for binhex4 because cannot decode line-by-line.
  323. LIsThisTheFirstLine: Boolean; //Needed for binary encoding
  324. LBoundaryStart, LBoundaryEnd: string;
  325. LIsBinaryContentTransferEncoding: Boolean;
  326. LEncoding: IIdTextEncoding;
  327. begin
  328. LIsThisTheFirstLine := True;
  329. VMsgEnd := False;
  330. Result := nil;
  331. if FBodyEncoded then begin
  332. LContentType := TIdMessage(Owner).ContentType;
  333. LContentTransferEncoding := ExtractHeaderItem(TIdMessage(Owner).ContentTransferEncoding);
  334. end else begin
  335. LContentType := FHeaders.Values['Content-Type']; {Do not Localize}
  336. LContentTransferEncoding := ExtractHeaderItem(FHeaders.Values['Content-Transfer-Encoding']); {Do not Localize}
  337. end;
  338. if LContentTransferEncoding = '' then begin
  339. // RLebeau 04/08/2014: According to RFC 2045 Section 6.1:
  340. // "Content-Transfer-Encoding: 7BIT" is assumed if the
  341. // Content-Transfer-Encoding header field is not present."
  342. if IsHeaderMediaType(LContentType, 'application/mac-binhex40') then begin {Do not Localize}
  343. LContentTransferEncoding := 'binhex40'; {do not localize}
  344. end
  345. else if not IsHeaderMediaType(LContentType, 'application/octet-stream') then begin {Do not Localize}
  346. LContentTransferEncoding := '7bit'; {do not localize}
  347. end;
  348. end
  349. else if IsHeaderMediaType(LContentType, 'multipart') then {do not localize}
  350. begin
  351. // RLebeau 08/17/09 - According to RFC 2045 Section 6.4:
  352. // "If an entity is of type "multipart" the Content-Transfer-Encoding is not
  353. // permitted to have any value other than "7bit", "8bit" or "binary"."
  354. //
  355. // However, came across one message where the "Content-Type" was set to
  356. // "multipart/related" and the "Content-Transfer-Encoding" was set to
  357. // "quoted-printable". Outlook and Thunderbird were apparently able to parse
  358. // the message correctly, but Indy was not. So let's check for that scenario
  359. // and ignore illegal "Content-Transfer-Encoding" values if present...
  360. if PosInStrArray(LContentTransferEncoding, ['7bit', '8bit', 'binary'], False) = -1 then begin {do not localize}
  361. LContentTransferEncoding := '';
  362. end;
  363. end;
  364. if TextIsSame(LContentTransferEncoding, 'base64') then begin {Do not Localize}
  365. LDecoder := TIdDecoderMIMELineByLine.Create(nil);
  366. end else if TextIsSame(LContentTransferEncoding, 'quoted-printable') then begin {Do not Localize}
  367. LDecoder := TIdDecoderQuotedPrintable.Create(nil);
  368. end else if TextIsSame(LContentTransferEncoding, 'binhex40') then begin {Do not Localize}
  369. LDecoder := TIdDecoderBinHex4.Create(nil);
  370. end else begin
  371. LDecoder := nil;
  372. end;
  373. try
  374. if LDecoder <> nil then begin
  375. LDecoder.DecodeBegin(ADestStream);
  376. end;
  377. if MIMEBoundary <> '' then begin
  378. LBoundaryStart := '--' + MIMEBoundary; {Do not Localize}
  379. LBoundaryEnd := LBoundaryStart + '--'; {Do not Localize}
  380. end;
  381. if LContentTransferEncoding <> '' then begin
  382. case PosInStrArray(LContentTransferEncoding, ['7bit', 'quoted-printable', 'base64', '8bit', 'binary'], False) of {do not localize}
  383. 0..2: LIsBinaryContentTransferEncoding := False;
  384. 3..4: LIsBinaryContentTransferEncoding := True;
  385. else
  386. // According to RFC 2045 Section 6.4:
  387. // "Any entity with an unrecognized Content-Transfer-Encoding must be
  388. // treated as if it has a Content-Type of "application/octet-stream",
  389. // regardless of what the Content-Type header field actually says."
  390. LIsBinaryContentTransferEncoding := True;
  391. LContentTransferEncoding := '';
  392. end;
  393. end else begin
  394. LIsBinaryContentTransferEncoding := True;
  395. end;
  396. repeat
  397. if not FProcessFirstLine then begin
  398. EnsureEncoding(LEncoding, enc8Bit);
  399. if LIsBinaryContentTransferEncoding then begin
  400. // For binary, need EOL because the default LF causes spurious CRs in the output...
  401. // TODO: don't use ReadLnRFC() for binary data at all. Read into an intermediate
  402. // buffer instead, looking for the next MIME boundary and message terminator while
  403. // flushing the buffer to the destination stream along the way. Otherwise, at the
  404. // very least, we need to detect the type of line break used (CRLF vs bare-LF) so
  405. // we can duplicate it correctly in the output. Most systems use CRLF, per the RFCs,
  406. // but have seen systems use bare-LF instead...
  407. LLine := ReadLnRFC(VMsgEnd, EOL, '.', LEncoding); {do not localize}
  408. LBinaryLineBreak := EOL; // TODO: detect the actual line break used
  409. end else begin
  410. LLine := ReadLnRFC(VMsgEnd, LF, '.', LEncoding); {do not localize}
  411. end;
  412. end else begin
  413. LLine := FFirstLine;
  414. FFirstLine := ''; {Do not Localize}
  415. FProcessFirstLine := False;
  416. // Do not use ADELIM since always ends with . (standard)
  417. if LLine = '.' then begin {Do not Localize}
  418. VMsgEnd := True;
  419. Break;
  420. end;
  421. if TextStartsWith(LLine, '..') then begin
  422. Delete(LLine, 1, 1);
  423. end;
  424. end;
  425. if VMsgEnd then begin
  426. Break;
  427. end;
  428. // New boundary - end self and create new coder
  429. if MIMEBoundary <> '' then begin
  430. if TextIsSame(LLine, LBoundaryStart) then begin
  431. Result := TIdMessageDecoderMIME.Create(Owner);
  432. Break;
  433. // End of all coders (not quite ALL coders)
  434. end;
  435. if TextIsSame(LLine, LBoundaryEnd) then begin
  436. // POP the boundary
  437. if Owner is TIdMessage then begin
  438. TIdMessage(Owner).MIMEBoundary.Pop;
  439. end;
  440. Break;
  441. end;
  442. end;
  443. if LDecoder = nil then begin
  444. // Data to save, but not decode
  445. if Assigned(ADestStream) then begin
  446. EnsureEncoding(LEncoding, enc8Bit);
  447. end;
  448. if LIsBinaryContentTransferEncoding then begin {do not localize}
  449. //In this case, we have to make sure we dont write out an EOL at the
  450. //end of the file.
  451. if LIsThisTheFirstLine then begin
  452. LIsThisTheFirstLine := False;
  453. end else begin
  454. if Assigned(ADestStream) then begin
  455. WriteStringToStream(ADestStream, LBinaryLineBreak, LEncoding);
  456. end;
  457. end;
  458. if Assigned(ADestStream) then begin
  459. WriteStringToStream(ADestStream, LLine, LEncoding);
  460. end;
  461. end else begin
  462. if Assigned(ADestStream) then begin
  463. WriteStringToStream(ADestStream, LLine + EOL, LEncoding);
  464. end;
  465. end;
  466. end
  467. else begin
  468. // Data to decode
  469. if LDecoder is TIdDecoderQuotedPrintable then begin
  470. // For TIdDecoderQuotedPrintable, we have to make sure all EOLs are intact
  471. LDecoder.Decode(LLine + EOL);
  472. end else if LDecoder is TIdDecoderBinHex4 then begin
  473. // We cannot decode line-by-line because lines don't have a whole
  474. // number of 4-byte blocks due to the : inserted at the start of
  475. // the first line, so buffer the file...
  476. // TODO: flush the buffer periodically when it has enough blocks
  477. // in it, otherwise we are buffering the entire file in memory
  478. // before decoding it...
  479. LBuffer := LBuffer + LLine;
  480. end else if LLine <> '' then begin
  481. LDecoder.Decode(LLine);
  482. end;
  483. end;
  484. until False;
  485. if LDecoder <> nil then begin
  486. if LDecoder is TIdDecoderBinHex4 then begin
  487. //Now decode the complete block...
  488. LDecoder.Decode(LBuffer);
  489. end;
  490. LDecoder.DecodeEnd;
  491. end;
  492. finally
  493. LDecoder.Free;
  494. end;
  495. end;
  496. function TIdMessageDecoderMIME.GetAttachmentFilename(const AContentType, AContentDisposition: string): string;
  497. var
  498. LValue: string;
  499. begin
  500. LValue := ExtractHeaderSubItem(AContentDisposition, 'filename', QuoteMIME); {do not localize}
  501. if LValue = '' then begin
  502. // Get filename from Content-Type
  503. LValue := ExtractHeaderSubItem(AContentType, 'name', QuoteMIME); {do not localize}
  504. end;
  505. if LValue <> '' then begin
  506. // TODO: if the '=?charset?encoding?data?=' MIME format is not detected,
  507. // decode as raw UTF-8 if no other charset is known, per RFC 7578 section 5.1.3...
  508. Result := RemoveInvalidCharsFromFilename(DecodeHeader(LValue));
  509. end else begin
  510. Result := '';
  511. end;
  512. end;
  513. procedure TIdMessageDecoderMIME.CheckAndSetType(const AContentType, AContentDisposition: string);
  514. begin
  515. {The new world order: Indy now defines a TIdAttachment as a part that either has
  516. a filename, or else does NOT have a ContentType starting with text/ or multipart/.
  517. Anything left is a TIdText.}
  518. {RLebeau 3/28/2006: RFC 2183 states that inlined text can have
  519. filenames as well, so do NOT treat inlined text as attachments!}
  520. //WARNING: Attachments may not necessarily have filenames, and Text parts may have filenames!
  521. FFileName := GetAttachmentFilename(AContentType, AContentDisposition);
  522. {see what type the part is...}
  523. if IsHeaderMediaTypes(AContentType, ['text', 'multipart']) and {do not localize}
  524. (not IsHeaderValue(AContentDisposition, 'attachment')) then {do not localize}
  525. begin
  526. // TODO: According to RFC 2045 Section 6.4:
  527. // "Any entity with an unrecognized Content-Transfer-Encoding must be
  528. // treated as if it has a Content-Type of "application/octet-stream",
  529. // regardless of what the Content-Type header field actually says."
  530. FPartType := mcptText;
  531. end else begin
  532. FPartType := mcptAttachment;
  533. end;
  534. end;
  535. function TIdMessageDecoderMIME.GetProperHeaderItem(const Line: string): string;
  536. var
  537. LPos, Idx, LLen: Integer;
  538. begin
  539. LPos := Pos(':', Line);
  540. if LPos = 0 then begin // the header line is invalid
  541. Result := Line;
  542. Exit;
  543. end;
  544. Idx := LPos - 1;
  545. while (Idx > 0) and (Line[Idx] = ' ') do begin
  546. Dec(Idx);
  547. end;
  548. LLen := Length(Line);
  549. Inc(LPos);
  550. while (LPos <= LLen) and (Line[LPos] = ' ') do begin
  551. Inc(LPos);
  552. end;
  553. Result := Copy(Line, 1, Idx) + '=' + Copy(Line, LPos, MaxInt);
  554. end;
  555. procedure TIdMessageDecoderMIME.ReadHeader;
  556. var
  557. ABoundary,
  558. s: string;
  559. LLine: string;
  560. LMsgEnd: Boolean;
  561. begin
  562. if FBodyEncoded then begin // Read header from the actual message since body parts don't exist {Do not Localize}
  563. CheckAndSetType(TIdMessage(Owner).ContentType, TIdMessage(Owner).ContentDisposition);
  564. end else begin
  565. // Read header
  566. repeat
  567. LLine := ReadLnRFC(LMsgEnd);
  568. if LMsgEnd then begin // TODO: abnormal situation (Masters!) {Do not Localize}
  569. FPartType := mcptEOF;
  570. Exit;
  571. end;//if
  572. if LLine = '' then begin
  573. Break;
  574. end;
  575. if CharIsInSet(LLine, 1, LWS) then begin
  576. if FHeaders.Count > 0 then begin
  577. FHeaders[FHeaders.Count - 1] := FHeaders[FHeaders.Count - 1] + ' ' + TrimLeft(LLine); {Do not Localize}
  578. end else begin
  579. //Make sure you change 'Content-Type :' to 'Content-Type:'
  580. FHeaders.Add(GetProperHeaderItem(TrimLeft(LLine))); {Do not Localize}
  581. end;
  582. end else begin
  583. //Make sure you change 'Content-Type :' to 'Content-Type:'
  584. FHeaders.Add(GetProperHeaderItem(LLine)); {Do not Localize}
  585. end;
  586. until False;
  587. s := FHeaders.Values['Content-Type']; {do not localize}
  588. //CC: Need to detect on "multipart" rather than boundary, because only the
  589. //"multipart" bit will be visible later...
  590. if IsHeaderMediaType(s, 'multipart') then begin {do not localize}
  591. ABoundary := ExtractHeaderSubItem(s, 'boundary', QuoteMIME); {do not localize}
  592. if Owner is TIdMessage then begin
  593. if ABoundary <> '' then begin
  594. TIdMessage(Owner).MIMEBoundary.Push(ABoundary, TIdMessage(Owner).MessageParts.Count);
  595. // Also update current boundary
  596. FMIMEBoundary := ABoundary;
  597. end else begin
  598. //CC: We are in trouble. A multipart MIME Content-Type with no boundary?
  599. //Try pushing the current boundary...
  600. TIdMessage(Owner).MIMEBoundary.Push(FMIMEBoundary, TIdMessage(Owner).MessageParts.Count);
  601. end;
  602. end;
  603. end;
  604. CheckAndSetType(FHeaders.Values['Content-Type'], {do not localize}
  605. FHeaders.Values['Content-Disposition']); {do not localize}
  606. end;
  607. end;
  608. function TIdMessageDecoderMIME.RemoveInvalidCharsFromFilename(const AFilename: string): string;
  609. const
  610. // MtW: Inversed: see http://support.microsoft.com/default.aspx?scid=kb;en-us;207188
  611. InvalidWindowsFilenameChars = '\/:*?"<>|'; {do not localize}
  612. var
  613. LN, LIdx: Integer;
  614. LChar: Char;
  615. {$IFDEF STRING_IS_IMMUTABLE}
  616. LSB: TIdStringBuilder;
  617. {$ENDIF}
  618. begin
  619. Result := AFilename;
  620. //First, strip any Windows or Unix path...
  621. if DecodeFilenamePathDelimiterAction = actTruncatePath then begin
  622. for LN := Length(Result) downto 1 do begin
  623. if ((Result[LN] = '/') or (Result[LN] = '\')) then begin {do not localize}
  624. Result := Copy(Result, LN+1, MaxInt);
  625. Break;
  626. end;
  627. end;
  628. end;
  629. //Now remove any invalid filename chars.
  630. //Hmm - this code will be less buggy if I just replace them with _
  631. {$IFDEF STRING_IS_IMMUTABLE}
  632. LSB := TIdStringBuilder.Create(Result);
  633. for LN := 0 to LSB.Length-1 do begin
  634. // MtW: WAS: if Pos(Result[LN], ValidWindowsFilenameChars) = 0 then begin
  635. // TODO: use CharIsInSet() instead?
  636. LChar := LSB[LN];
  637. for LIdx := 1 to Length(InvalidWindowsFilenameChars) do begin
  638. if InvalidWindowsFilenameChars[LIdx] = LChar then begin
  639. LSB[LN] := '_'; {do not localize}
  640. Break;
  641. end;
  642. end;
  643. end;
  644. {$ELSE}
  645. for LN := 1 to Length(Result) do begin
  646. // MtW: WAS: if Pos(Result[LN], ValidWindowsFilenameChars) = 0 then begin
  647. // TODO: use CharIsInSet() instead?
  648. LChar := Result[LN];
  649. for LIdx := 1 to Length(InvalidWindowsFilenameChars) do begin
  650. if InvalidWindowsFilenameChars[LIdx] = LChar then begin
  651. Result[LN] := '_'; {do not localize}
  652. Break;
  653. end;
  654. end;
  655. end;
  656. {$ENDIF}
  657. end;
  658. { TIdMessageEncoderInfoMIME }
  659. constructor TIdMessageEncoderInfoMIME.Create;
  660. begin
  661. inherited;
  662. FMessageEncoderClass := TIdMessageEncoderMIME;
  663. end;
  664. procedure TIdMessageEncoderInfoMIME.InitializeHeaders(AMsg: TIdMessage);
  665. begin
  666. {CC2: The following logic does not work - it assumes that just because there
  667. are related parts, that the message header is multipart/related, whereas it
  668. could be multipart/related inside multipart/alternative, plus there are other
  669. issues.
  670. But...it works on simple emails, and it is better than throwing an exception.
  671. User must specify the ContentType to get the right results.}
  672. {CC4: removed addition of boundaries; now added at GenerateHeader stage (could
  673. end up with boundary added more than once)}
  674. if AMsg.ContentType = '' then begin
  675. if AMsg.MessageParts.RelatedPartCount > 0 then begin
  676. AMsg.ContentType := 'multipart/related; type="multipart/alternative"'; //; boundary="' + {do not localize}
  677. end else begin
  678. if AMsg.MessageParts.AttachmentCount > 0 then begin
  679. AMsg.ContentType := 'multipart/mixed'; //; boundary="' {do not localize}
  680. end else begin
  681. if AMsg.MessageParts.TextPartCount > 0 then begin
  682. AMsg.ContentType := 'multipart/alternative'; //; boundary="' {do not localize}
  683. end;
  684. end;
  685. end;
  686. end;
  687. end;
  688. { TIdMessageEncoderMIME }
  689. procedure TIdMessageEncoderMIME.Encode(ASrc: TStream; ADest: TStream);
  690. var
  691. s: string;
  692. LEncoder: TIdEncoderMIME;
  693. LSPos, LSSize : Int64;
  694. begin
  695. ASrc.Position := 0;
  696. LSPos := 0;
  697. LSSize := ASrc.Size;
  698. LEncoder := TIdEncoderMIME.Create(nil);
  699. try
  700. while LSPos < LSSize do begin
  701. s := LEncoder.Encode(ASrc, 57) + EOL;
  702. Inc(LSPos, 57);
  703. WriteStringToStream(ADest, s);
  704. end;
  705. finally
  706. LEncoder.Free;
  707. end;
  708. end;
  709. initialization
  710. TIdMessageDecoderList.RegisterDecoder('MIME' {Do not Localize}
  711. , TIdMessageDecoderInfoMIME.Create);
  712. TIdMessageEncoderList.RegisterEncoder('MIME' {Do not Localize}
  713. , TIdMessageEncoderInfoMIME.Create);
  714. finalization
  715. end.