1b39c5158Smillert# 2*3d61058aSafresh1# $Id: mime-header.t,v 2.17 2023/11/10 01:10:50 dankogai Exp $ 3b39c5158Smillert# This script is written in utf8 4b39c5158Smillert# 5b39c5158SmillertBEGIN { 6b39c5158Smillert if ($ENV{'PERL_CORE'}){ 7b39c5158Smillert chdir 't'; 8b39c5158Smillert unshift @INC, '../lib'; 9b39c5158Smillert } 10*3d61058aSafresh1 require Config; Config->import(); 11b39c5158Smillert if ($Config{'extensions'} !~ /\bEncode\b/) { 12b39c5158Smillert print "1..0 # Skip: Encode was not built\n"; 13b39c5158Smillert exit 0; 14b39c5158Smillert } 15b39c5158Smillert if (ord("A") == 193) { 16b39c5158Smillert print "1..0 # Skip: EBCDIC\n"; 17b39c5158Smillert exit 0; 18b39c5158Smillert } 19b39c5158Smillert $| = 1; 20b39c5158Smillert} 21b39c5158Smillert 22b39c5158Smillertuse strict; 23b39c5158Smillert 24b39c5158Smillertuse utf8; 25b39c5158Smillertuse charnames ":full"; 269f11ffb7Safresh1 27e0680481Safresh1use Test::More tests => 274; 289f11ffb7Safresh1 299f11ffb7Safresh1BEGIN { 309f11ffb7Safresh1 use_ok("Encode::MIME::Header"); 31b39c5158Smillert} 32b39c5158Smillert 339f11ffb7Safresh1my @decode_long_tests; 349f11ffb7Safresh1if ($] < 5.009004) { # perl versions without Regular expressions Engine de-recursivised which cause stack overflow 359f11ffb7Safresh1 push(@decode_long_tests, "a" x 1000000 => "a" x 1000000); 369f11ffb7Safresh1 push(@decode_long_tests, "=?utf-8?Q?a?= " x 400 => "a" x 400 . " "); 379f11ffb7Safresh1 push(@decode_long_tests, "=?utf-8?Q?a?= =?US-ASCII?Q?b?= " x 200 => "ab" x 200 . " "); 389f11ffb7Safresh1} else { 399f11ffb7Safresh1 push(@decode_long_tests, "a" x 1000000 => "a" x 1000000); 409f11ffb7Safresh1 push(@decode_long_tests, "=?utf-8?Q?a?= " x 10000 => "a" x 10000 . " "); 419f11ffb7Safresh1 push(@decode_long_tests, "=?utf-8?Q?a?= =?US-ASCII?Q?b?= " x 10000 => "ab" x 10000 . " "); 429f11ffb7Safresh1} 43b39c5158Smillert 449f11ffb7Safresh1my @decode_tests = ( 459f11ffb7Safresh1 # RFC2047 p.5 469f11ffb7Safresh1 "=?iso-8859-1?q?this=20is=20some=20text?=" => "this is some text", 479f11ffb7Safresh1 # RFC2047 p.10 489f11ffb7Safresh1 "=?US-ASCII?Q?Keith_Moore?=" => "Keith Moore", 499f11ffb7Safresh1 "=?ISO-8859-1?Q?Keld_J=F8rn_Simonsen?=" => "Keld Jørn Simonsen", 509f11ffb7Safresh1 "=?ISO-8859-1?Q?Andr=E9?= Pirard" => "André Pirard", 519f11ffb7Safresh1 "=?ISO-8859-1?B?SWYgeW91IGNhbiByZWFkIHRoaXMgeW8=?=\r\n =?ISO-8859-2?B?dSB1bmRlcnN0YW5kIHRoZSBleGFtcGxlLg==?=" => "If you can read this you understand the example.", 529f11ffb7Safresh1 "=?ISO-8859-1?Q?Olle_J=E4rnefors?=" => "Olle Järnefors", 539f11ffb7Safresh1 "=?ISO-8859-1?Q?Patrik_F=E4ltstr=F6m?=" => "Patrik Fältström", 549f11ffb7Safresh1 # RFC2047 p.11 559f11ffb7Safresh1 "(=?iso-8859-8?b?7eXs+SDv4SDp7Oj08A==?=)" => "(םולש ןב ילטפנ)", 569f11ffb7Safresh1 "(=?ISO-8859-1?Q?a?=)" => "(a)", 579f11ffb7Safresh1 "(=?ISO-8859-1?Q?a?= b)" => "(a b)", 589f11ffb7Safresh1 "(=?ISO-8859-1?Q?a?= =?ISO-8859-1?Q?b?=)" => "(ab)", 599f11ffb7Safresh1 "(=?ISO-8859-1?Q?a?= =?ISO-8859-1?Q?b?=)" => "(ab)", 609f11ffb7Safresh1 "(=?ISO-8859-1?Q?a?=\r\n\t=?ISO-8859-1?Q?b?=)" => "(ab)", 619f11ffb7Safresh1 # RFC2047 p.12 629f11ffb7Safresh1 "(=?ISO-8859-1?Q?a_b?=)" => '(a b)', 639f11ffb7Safresh1 "(=?ISO-8859-1?Q?a?= =?ISO-8859-2?Q?_b?=)" => "(a b)", 649f11ffb7Safresh1 # RFC2231 p.6 659f11ffb7Safresh1 "=?US-ASCII*EN?Q?Keith_Moore?=" => "Keith Moore", 669f11ffb7Safresh1 # others 679f11ffb7Safresh1 "=?US-ASCII*en-US?Q?Keith_Moore?=" => "Keith Moore", 689f11ffb7Safresh1 "=?ISO-8859-1*da-DK?Q?Keld_J=F8rn_Simonsen?=" => "Keld Jørn Simonsen", 699f11ffb7Safresh1 "=?ISO-8859-1*fr-BE?Q?Andr=E9?= Pirard" => "André Pirard", 709f11ffb7Safresh1 "=?ISO-8859-1*en?B?SWYgeW91IGNhbiByZWFkIHRoaXMgeW8=?= =?ISO-8859-2?B?dSB1bmRlcnN0YW5kIHRoZSBleGFtcGxlLg==?=" => "If you can read this you understand the example.", 719f11ffb7Safresh1 # multiple (separated by CRLF) 729f11ffb7Safresh1 "=?US-ASCII?Q?a?=\r\n=?US-ASCII?Q?b?=" => "a\r\nb", 739f11ffb7Safresh1 "a\r\nb" => "a\r\nb", 749f11ffb7Safresh1 "a\r\n\r\nb" => "a\r\n\r\nb", 759f11ffb7Safresh1 "a\r\n\r\nb\r\n" => "a\r\n\r\nb\r\n", 769f11ffb7Safresh1 # multiple multiline (separated by CRLF) 779f11ffb7Safresh1 "=?US-ASCII?Q?a?=\r\n =?US-ASCII?Q?b?=\r\n=?US-ASCII?Q?c?=" => "ab\r\nc", 789f11ffb7Safresh1 "a\r\n b\r\nc" => "a b\r\nc", 799f11ffb7Safresh1 # RT67569 809f11ffb7Safresh1 "foo =?us-ascii?q?bar?=" => "foo bar", 819f11ffb7Safresh1 "foo\r\n =?us-ascii?q?bar?=" => "foo bar", 829f11ffb7Safresh1 "=?us-ascii?q?foo?= bar" => "foo bar", 839f11ffb7Safresh1 "=?us-ascii?q?foo?=\r\n bar" => "foo bar", 849f11ffb7Safresh1 "foo bar" => "foo bar", 859f11ffb7Safresh1 "foo\r\n bar" => "foo bar", 869f11ffb7Safresh1 "=?us-ascii?q?foo?= =?us-ascii?q?bar?=" => "foobar", 879f11ffb7Safresh1 "=?us-ascii?q?foo?=\r\n =?us-ascii?q?bar?=" => "foobar", 889f11ffb7Safresh1 # RT40027 899f11ffb7Safresh1 "a: b\r\n c" => "a: b c", 909f11ffb7Safresh1 # RT104422 919f11ffb7Safresh1 "=?utf-8?Q?pre?= =?utf-8?B?IGZvbw==?=\r\n =?utf-8?Q?bar?=" => "pre foobar", 929f11ffb7Safresh1 # RT114034 - replace invalid UTF-8 sequence with unicode replacement character 939f11ffb7Safresh1 "=?utf-8?Q?=f9=80=80=80=80?=" => "�", 949f11ffb7Safresh1 "=?utf-8?Q?=28=c3=29?=" => "(�)", 959f11ffb7Safresh1 # decode only known MIME charsets, do not crash on invalid 969f11ffb7Safresh1 "prefix =?unknown?Q?a=20b=20c?= middle =?US-ASCII?Q?d=20e=20f?= suffix" => "prefix =?unknown?Q?a=20b=20c?= middle d e f suffix", 979f11ffb7Safresh1 "prefix =?US-ASCII?Q?a_b_c?= =?unknown?Q?d_e_f?= suffix" => "prefix a b c =?unknown?Q?d_e_f?= suffix", 989f11ffb7Safresh1 "prefix =?US-ASCII?Q?a_b_c?= =?unknown?Q?d_e_f?= =?US-ASCII?Q?g_h_i?= suffix" => "prefix a b c =?unknown?Q?d_e_f?= g h i suffix", 999f11ffb7Safresh1 # long strings 1009f11ffb7Safresh1 @decode_long_tests, 1019f11ffb7Safresh1 # separators around encoded words 1029f11ffb7Safresh1 "\r\n =?US-ASCII?Q?a?=" => " a", 1039f11ffb7Safresh1 "\r\n (=?US-ASCII?Q?a?=)" => " (a)", 1049f11ffb7Safresh1 "\r\n (=?US-ASCII?Q?a?=)\r\n " => " (a) ", 1059f11ffb7Safresh1 "(=?US-ASCII?Q?a?=)\r\n " => "(a) ", 1069f11ffb7Safresh1 " (=?US-ASCII?Q?a?=) " => " (a) ", 1079f11ffb7Safresh1 "(=?US-ASCII?Q?a?=) " => "(a) ", 1089f11ffb7Safresh1 " (=?US-ASCII?Q?a?=)" => " (a)", 1099f11ffb7Safresh1 "(=?US-ASCII?Q?a?=)(=?US-ASCII?Q?b?=)" => "(a)(b)", 1109f11ffb7Safresh1 "(=?US-ASCII?Q?a?=) (=?US-ASCII?Q?b?=)" => "(a) (b)", 1119f11ffb7Safresh1 "(=?US-ASCII?Q?a?=)\r\n (=?US-ASCII?Q?b?=)" => "(a) (b)", 1129f11ffb7Safresh1 "\r\n (=?US-ASCII?Q?a?=)\r\n (=?US-ASCII?Q?b?=)\r\n " => " (a) (b) ", 1139f11ffb7Safresh1 "\r\n(=?US-ASCII?Q?a?=)\r\n(=?US-ASCII?Q?b?=)" => "\r\n(a)\r\n(b)", 1149f11ffb7Safresh1); 1159f11ffb7Safresh1 1169f11ffb7Safresh1my @decode_default_tests = ( 1179f11ffb7Safresh1 @decode_tests, 1189f11ffb7Safresh1 "=?us-ascii?q?foo bar?=" => "foo bar", 1199f11ffb7Safresh1 "=?us-ascii?q?foo\r\n bar?=" => "foo bar", 1209f11ffb7Safresh1 '=?us-ascii?q?foo=20=3cbar=40baz=2efoo=3e=20bar?=' => 'foo <bar@baz.foo> bar', 1219f11ffb7Safresh1 '"=?us-ascii?q?foo=20=3cbar=40baz=2efoo=3e=20bar?="' => '"foo <bar@baz.foo> bar"', 1229f11ffb7Safresh1 "=?us-ascii?q?foo?==?us-ascii?q?bar?=" => "foobar", 1239f11ffb7Safresh1 "foo=?us-ascii?q?bar?=" => "foobar", 1249f11ffb7Safresh1 "foo =?us-ascii?q?=20?==?us-ascii?q?bar?=" => "foo bar", 1259f11ffb7Safresh1 # Encode::MIME::Header pre 2.83 1269f11ffb7Safresh1 "[=?UTF-8?B?ZsOzcnVt?=]=?UTF-8?B?IHNwcsOhdmE=?=" => "[fórum] správa", 1279f11ffb7Safresh1 "test:=?UTF-8?B?IHNwcsOhdmE=?=" => "test: správa", 1289f11ffb7Safresh1 "=?UTF-8?B?dMOpc3Q=?=:=?UTF-8?B?IHNwcsOhdmE=?=", "tést: správa", 1299f11ffb7Safresh1 # multiple base64 parts in one b word 1309f11ffb7Safresh1 "=?us-ascii?b?Zg==Zg==?=" => "ff", 1319f11ffb7Safresh1 # b word with invalid characters 1329f11ffb7Safresh1 "=?us-ascii?b?Zm!!9!v?=" => "foo", 1339f11ffb7Safresh1 # concat consecutive words (with same parameters) and join them into one utf-8 symbol 1349f11ffb7Safresh1 "=?UTF-8?Q?=C3?= =?UTF-8?Q?=A1?=" => "á", 1359f11ffb7Safresh1 # RT114034 - use strict UTF-8 decoder for invalid MIME charsets utf8, UTF8 and utf-8-strict 1369f11ffb7Safresh1 "=?utf8?Q?=C3=A1=f9=80=80=80=80?=" => "á�", 1379f11ffb7Safresh1 "=?UTF8?Q?=C3=A1=f9=80=80=80=80?=" => "á�", 1389f11ffb7Safresh1 "=?utf-8-strict?Q?=C3=A1=f9=80=80=80=80?=" => "á�", 1399f11ffb7Safresh1 # allow non-ASCII characters in q word 1409f11ffb7Safresh1 "=?UTF-8?Q?\x{C3}\x{A1}?=" => "á", 141e0680481Safresh1 # allow missing padding characters '=' in b word 142e0680481Safresh1 "=?UTF-8?B?JQ?=" => "%", 143e0680481Safresh1 "=?UTF-8?B?JQ?= =?UTF-8?B?JQ?=" => "%%", 144e0680481Safresh1 "=?UTF-8?B?YWI?=" => "ab", 145e0680481Safresh1 "=?UTF-8?B?YWI?= =?UTF-8?B?YWI?=" => "abab", 1469f11ffb7Safresh1); 1479f11ffb7Safresh1 1489f11ffb7Safresh1my @decode_strict_tests = ( 1499f11ffb7Safresh1 @decode_tests, 1509f11ffb7Safresh1 "=?us-ascii?q?foo bar?=" => "=?us-ascii?q?foo bar?=", 1519f11ffb7Safresh1 "=?us-ascii?q?foo\r\n bar?=" => "=?us-ascii?q?foo bar?=", 1529f11ffb7Safresh1 '=?us-ascii?q?foo=20=3cbar=40baz=2efoo=3e=20bar?=' => 'foo <bar@baz.foo> bar', 1539f11ffb7Safresh1 '"=?us-ascii?q?foo=20=3cbar=40baz=2efoo=3e=20bar?="' => '"=?us-ascii?q?foo=20=3cbar=40baz=2efoo=3e=20bar?="', 1549f11ffb7Safresh1 # do not decode invalid q words 1559f11ffb7Safresh1 "=?us-ascii?q?foo=?=" => "=?us-ascii?q?foo=?=", 1569f11ffb7Safresh1 "=?us-ascii?q?foo=?= =?us-ascii?q?foo?=" => "=?us-ascii?q?foo=?= foo", 1579f11ffb7Safresh1 # do not decode invalid b words 1589f11ffb7Safresh1 "=?us-ascii?b?----?=" => "=?us-ascii?b?----?=", 1599f11ffb7Safresh1 "=?us-ascii?b?Zm8=-?= =?us-ascii?b?Zm9v?= and =?us-ascii?b?Zg==?=" => "=?us-ascii?b?Zm8=-?= foo and f", 1609f11ffb7Safresh1 "=?us-ascii?b?----?= =?us-ascii?b?Zm9v?= and =?us-ascii?b?Zg==?=" => "=?us-ascii?b?----?= foo and f", 1619f11ffb7Safresh1 # RT114034 - utf8, UTF8 and also utf-8-strict are invalid MIME charset, do not decode it 1629f11ffb7Safresh1 "=?utf8?Q?=C3=A1?=" => "=?utf8?Q?=C3=A1?=", 1639f11ffb7Safresh1 "=?UTF8?Q?=C3=A1?=" => "=?UTF8?Q?=C3=A1?=", 1649f11ffb7Safresh1 "=?utf-8-strict?Q?=C3=A1?=" => "=?utf-8-strict?Q?=C3=A1?=", 1659f11ffb7Safresh1 # do not allow non-ASCII characters in q word 1669f11ffb7Safresh1 "=?UTF-8?Q?\x{C3}\x{A1}?=" => "=?UTF-8?Q?\x{C3}\x{A1}?=", 167e0680481Safresh1 # do not allow missing padding characters '=' in b word 168e0680481Safresh1 "=?UTF-8?B?JQ?=" => "=?UTF-8?B?JQ?=", 169e0680481Safresh1 "=?UTF-8?B?JQ?= =?UTF-8?B?JQ?=" => "=?UTF-8?B?JQ?= =?UTF-8?B?JQ?=", 170e0680481Safresh1 "=?UTF-8?B?YWI?=" => "=?UTF-8?B?YWI?=", 171e0680481Safresh1 "=?UTF-8?B?YWI?= =?UTF-8?B?YWI?=" => "=?UTF-8?B?YWI?= =?UTF-8?B?YWI?=", 1729f11ffb7Safresh1); 1739f11ffb7Safresh1 1749f11ffb7Safresh1my @encode_tests = ( 1759f11ffb7Safresh1 "小飼 弾" => "=?UTF-8?B?5bCP6aO8IOW8vg==?=", "=?UTF-8?Q?=E5=B0=8F=E9=A3=BC_=E5=BC=BE?=", 1769f11ffb7Safresh1 "漢字、カタカナ、ひらがなを含む、非常に長いタイトル行が一体全体どのようにしてEncodeされるのか?" => "=?UTF-8?B?5ryi5a2X44CB44Kr44K/44Kr44OK44CB44Gy44KJ44GM44Gq44KS5ZCr44KA?=\r\n =?UTF-8?B?44CB6Z2e5bi444Gr6ZW344GE44K/44Kk44OI44Or6KGM44GM5LiA5L2T5YWo?=\r\n =?UTF-8?B?5L2T44Gp44Gu44KI44GG44Gr44GX44GmRW5jb2Rl44GV44KM44KL44Gu44GL?=\r\n =?UTF-8?B?77yf?=", "=?UTF-8?Q?=E6=BC=A2=E5=AD=97=E3=80=81=E3=82=AB=E3=82=BF=E3=82=AB=E3=83=8A?=\r\n =?UTF-8?Q?=E3=80=81=E3=81=B2=E3=82=89=E3=81=8C=E3=81=AA=E3=82=92=E5=90=AB?=\r\n =?UTF-8?Q?=E3=82=80=E3=80=81=E9=9D=9E=E5=B8=B8=E3=81=AB=E9=95=B7=E3=81=84?=\r\n =?UTF-8?Q?=E3=82=BF=E3=82=A4=E3=83=88=E3=83=AB=E8=A1=8C=E3=81=8C=E4=B8=80?=\r\n =?UTF-8?Q?=E4=BD=93=E5=85=A8=E4=BD=93=E3=81=A9=E3=81=AE=E3=82=88=E3=81=86?=\r\n =?UTF-8?Q?=E3=81=AB=E3=81=97=E3=81=A6Encode=E3=81=95=E3=82=8C=E3=82=8B?=\r\n =?UTF-8?Q?=E3=81=AE=E3=81=8B=EF=BC=9F?=", 1779f11ffb7Safresh1 # double encode 1789f11ffb7Safresh1 "What is =?UTF-8?B?w4RwZmVs?= ?" => "=?UTF-8?B?V2hhdCBpcyA9P1VURi04P0I/dzRSd1ptVnM/PSA/?=", "=?UTF-8?Q?What_is_=3D=3FUTF-8=3FB=3Fw4RwZmVs=3F=3D_=3F?=", 1799f11ffb7Safresh1 # pound 1024 1809f11ffb7Safresh1 "\N{POUND SIGN}1024" => "=?UTF-8?B?wqMxMDI0?=", "=?UTF-8?Q?=C2=A31024?=", 1819f11ffb7Safresh1 # latin1 characters 1829f11ffb7Safresh1 "\x{fc}" => "=?UTF-8?B?w7w=?=", "=?UTF-8?Q?=C3=BC?=", 183b39c5158Smillert # RT42627 1849f11ffb7Safresh1 Encode::decode_utf8("\x{c2}\x{a3}xxxxxxxxxxxxxxxxxxx0") => "=?UTF-8?B?wqN4eHh4eHh4eHh4eHh4eHh4eHh4MA==?=", "=?UTF-8?Q?=C2=A3xxxxxxxxxxxxxxxxxxx0?=", 185e5157e49Safresh1 # RT87831 1869f11ffb7Safresh1 "0" => "=?UTF-8?B?MA==?=", "=?UTF-8?Q?0?=", 1879f11ffb7Safresh1 # RT88717 1889f11ffb7Safresh1 "Hey foo\x{2024}bar:whee" => "=?UTF-8?B?SGV5IGZvb+KApGJhcjp3aGVl?=", "=?UTF-8?Q?Hey_foo=E2=80=A4bar=3Awhee?=", 1899f11ffb7Safresh1 # valid q chars 1909f11ffb7Safresh1 "0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz !*+-/" => "=?UTF-8?B?MDEyMzQ1Njc4OUFCQ0RFRkdISUpLTE1OT1BRUlNUVVZXWFlaYWJjZGVmZ2hp?=\r\n =?UTF-8?B?amtsbW5vcHFyc3R1dnd4eXogISorLS8=?=", "=?UTF-8?Q?0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz_?=\r\n =?UTF-8?Q?!*+-/?=", 1919f11ffb7Safresh1 # invalid q chars 1929f11ffb7Safresh1 "." => "=?UTF-8?B?Lg==?=", "=?UTF-8?Q?=2E?=", 1939f11ffb7Safresh1 "," => "=?UTF-8?B?LA==?=", "=?UTF-8?Q?=2C?=", 1949f11ffb7Safresh1 # long ascii sequence 1959f11ffb7Safresh1 "a" x 100 => "=?UTF-8?B?YWFhYWFhYWFhYWFhYWFhYWFhYWFhYWFhYWFhYWFhYWFhYWFhYWFhYWFhYWFh?=\r\n =?UTF-8?B?YWFhYWFhYWFhYWFhYWFhYWFhYWFhYWFhYWFhYWFhYWFhYWFhYWFhYWFhYWFh?=\r\n =?UTF-8?B?YWFhYWFhYWFhYQ==?=", "=?UTF-8?Q?aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa?=\r\n =?UTF-8?Q?aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa?=", 1969f11ffb7Safresh1 # long unicode sequence 1979f11ffb7Safresh1 "" x 100 => "=?UTF-8?B?8J+YgPCfmIDwn5iA8J+YgPCfmIDwn5iA8J+YgPCfmIDwn5iA8J+YgPCfmIA=?=\r\n " x 9 . "=?UTF-8?B?8J+YgA==?=", join("\r\n ", ("=?UTF-8?Q?=F0=9F=98=80=F0=9F=98=80=F0=9F=98=80=F0=9F=98=80=F0=9F=98=80?=") x 20), 1989f11ffb7Safresh1); 1999f11ffb7Safresh1 2009f11ffb7Safresh1sub info { 2019f11ffb7Safresh1 my ($str, $str1, $str2) = @_; 2029f11ffb7Safresh1 substr $str1, 1000, -3, "..." if defined $str1 and length $str1 > 1000; 2039f11ffb7Safresh1 substr $str2, 1000, -3, "..." if defined $str2 and length $str2 > 1000; 2049f11ffb7Safresh1 $str .= ": $str1" if defined $str1; 2059f11ffb7Safresh1 $str .= " => $str2" if defined $str2; 2069f11ffb7Safresh1 $str = Encode::encode_utf8($str); 2079f11ffb7Safresh1 $str =~ s/\r/\\r/gs; 2089f11ffb7Safresh1 $str =~ s/\n/\\n/gs; 2099f11ffb7Safresh1 return $str; 2109f11ffb7Safresh1} 2119f11ffb7Safresh1 2129f11ffb7Safresh1sub check_length { 2139f11ffb7Safresh1 my ($str) = @_; 2149f11ffb7Safresh1 my @lines = split /\r\n /, $str; 2159f11ffb7Safresh1 my @long = grep { length($_) > 75 } @lines; 2169f11ffb7Safresh1 return scalar @long == 0; 2179f11ffb7Safresh1} 2189f11ffb7Safresh1 2199f11ffb7Safresh1my @splice; 2209f11ffb7Safresh1 2219f11ffb7Safresh1@splice = @encode_tests; 2229f11ffb7Safresh1while (my ($d, $b, $q) = splice @splice, 0, 3) { 2239f11ffb7Safresh1 is Encode::encode("MIME-Header", $d) => $b, info("encode default", $d => $b); 2249f11ffb7Safresh1 is Encode::encode("MIME-B", $d) => $b, info("encode base64", $d => $b); 2259f11ffb7Safresh1 is Encode::encode("MIME-Q", $d) => $q, info("encode qp", $d => $q); 2269f11ffb7Safresh1 is Encode::decode("MIME-B", $b) => $d, info("decode base64", $b => $d); 2279f11ffb7Safresh1 is Encode::decode("MIME-Q", $q) => $d, info("decode qp", $b => $d); 2289f11ffb7Safresh1 ok check_length($b), info("correct encoded length base64", $b); 2299f11ffb7Safresh1 ok check_length($q), info("correct encoded length qp", $q); 2309f11ffb7Safresh1} 2319f11ffb7Safresh1 2329f11ffb7Safresh1@splice = @decode_default_tests; 2339f11ffb7Safresh1while (my ($e, $d) = splice @splice, 0, 2) { 2349f11ffb7Safresh1 is Encode::decode("MIME-Header", $e) => $d, info("decode default", $e => $d); 2359f11ffb7Safresh1} 2369f11ffb7Safresh1 2379f11ffb7Safresh1local $Encode::MIME::Header::STRICT_DECODE = 1; 2389f11ffb7Safresh1 2399f11ffb7Safresh1@splice = @decode_strict_tests; 2409f11ffb7Safresh1while (my ($e, $d) = splice @splice, 0, 2) { 2419f11ffb7Safresh1 is Encode::decode("MIME-Header", $e) => $d, info("decode strict", $e => $d); 2429f11ffb7Safresh1} 2439f11ffb7Safresh1 2449f11ffb7Safresh1my $valid_unicode = "á"; 2459f11ffb7Safresh1my $invalid_unicode = "\x{1000000}"; 2469f11ffb7Safresh1{ 2479f11ffb7Safresh1 my $input = $valid_unicode; 2489f11ffb7Safresh1 my $output = Encode::encode("MIME-Header", $input, Encode::FB_QUIET); 2499f11ffb7Safresh1 is $output => Encode::encode("MIME-Header", $valid_unicode), "encode valid with FB_QUIET flag: output string is valid"; 2509f11ffb7Safresh1 is $input => "", "encode valid with FB_QUIET flag: input string is modified and empty"; 2519f11ffb7Safresh1} 2529f11ffb7Safresh1{ 2539f11ffb7Safresh1 my $input = $valid_unicode . $invalid_unicode; 2549f11ffb7Safresh1 my $output = Encode::encode("MIME-Header", $input, Encode::FB_QUIET); 2559f11ffb7Safresh1 is $output => Encode::encode("MIME-Header", $valid_unicode), "encode with FB_QUIET flag: output string stops before first invalid character"; 2569f11ffb7Safresh1 is $input => $invalid_unicode, "encode with FB_QUIET flag: input string is modified and starts with first invalid character"; 2579f11ffb7Safresh1} 2589f11ffb7Safresh1{ 2599f11ffb7Safresh1 my $input = $valid_unicode . $invalid_unicode; 2609f11ffb7Safresh1 my $output = Encode::encode("MIME-Header", $input, Encode::FB_QUIET | Encode::LEAVE_SRC); 2619f11ffb7Safresh1 is $output => Encode::encode("MIME-Header", $valid_unicode), "encode with FB_QUIET and LEAVE_SRC flags: output string stops before first invalid character"; 2629f11ffb7Safresh1 is $input => $valid_unicode . $invalid_unicode, "encode with FB_QUIET and LEAVE_SRC flags: input string is not modified"; 2639f11ffb7Safresh1} 2649f11ffb7Safresh1{ 2659f11ffb7Safresh1 my $input = $valid_unicode . $invalid_unicode; 2669f11ffb7Safresh1 my $output = Encode::encode("MIME-Header", $input, Encode::FB_PERLQQ); 2679f11ffb7Safresh1 is $output => Encode::encode("MIME-Header", $valid_unicode . '\x{1000000}'), "encode with FB_PERLQQ flag: output string contains perl qq representation of invalid character"; 2689f11ffb7Safresh1 is $input => $valid_unicode . $invalid_unicode, "encode with FB_PERLQQ flag: input string is not modified"; 2699f11ffb7Safresh1} 2709f11ffb7Safresh1{ 2719f11ffb7Safresh1 my $input = $valid_unicode; 2729f11ffb7Safresh1 my $output = Encode::encode("MIME-Header", $input, sub { sprintf("!0x%X!", $_[0]) }); 2739f11ffb7Safresh1 is $output => Encode::encode("MIME-Header", $valid_unicode), "encode valid with coderef check: output string is valid"; 2749f11ffb7Safresh1 is $input => $valid_unicode, "encode valid with coderef check: input string is not modified"; 2759f11ffb7Safresh1} 2769f11ffb7Safresh1{ 2779f11ffb7Safresh1 my $input = $valid_unicode . $invalid_unicode; 2789f11ffb7Safresh1 my $output = Encode::encode("MIME-Header", $input, sub { sprintf("!0x%X!", $_[0]) }); 2799f11ffb7Safresh1 is $output => Encode::encode("MIME-Header", $valid_unicode . '!0x1000000!'), "encode with coderef check: output string contains output from coderef"; 2809f11ffb7Safresh1 is $input => $valid_unicode . $invalid_unicode, "encode with coderef check: input string is not modified"; 2819f11ffb7Safresh1} 2829f11ffb7Safresh1 2839f11ffb7Safresh1my $valid_mime = "=?US-ASCII?Q?d=20e=20f?="; 2849f11ffb7Safresh1my $invalid_mime = "=?unknown?Q?a=20b=20c?="; 2859f11ffb7Safresh1my $invalid_mime_unicode = "=?utf-8?Q?=28=c3=29?="; 2869f11ffb7Safresh1{ 2879f11ffb7Safresh1 my $input = $valid_mime; 2889f11ffb7Safresh1 my $output = Encode::decode("MIME-Header", $input, Encode::FB_QUIET); 2899f11ffb7Safresh1 is $output => Encode::decode("MIME-Header", $valid_mime), "decode valid with FB_QUIET flag: output string is valid"; 2909f11ffb7Safresh1 is $input => "", "decode valid with FB_QUIET flag: input string is modified and empty"; 2919f11ffb7Safresh1} 2929f11ffb7Safresh1{ 2939f11ffb7Safresh1 my $input = $valid_mime . " " . $invalid_mime; 2949f11ffb7Safresh1 my $output = Encode::decode("MIME-Header", $input, Encode::FB_QUIET); 2959f11ffb7Safresh1 is $output => Encode::decode("MIME-Header", $valid_mime), "decode with FB_QUIET flag: output string stops before first mime word with unknown charset"; 2969f11ffb7Safresh1 is $input => $invalid_mime, "decode with FB_QUIET flag: input string is modified and starts with first mime word with unknown charset"; 2979f11ffb7Safresh1} 2989f11ffb7Safresh1{ 2999f11ffb7Safresh1 my $input = $valid_mime . " " . $invalid_mime_unicode; 3009f11ffb7Safresh1 my $output = Encode::decode("MIME-Header", $input, Encode::FB_QUIET); 3019f11ffb7Safresh1 is $output => Encode::decode("MIME-Header", $valid_mime), "decode with FB_QUIET flag: output string stops before first mime word with invalid unicode character"; 3029f11ffb7Safresh1 is $input => $invalid_mime_unicode, "decode with FB_QUIET flag: input string is modified and starts with first mime word with invalid unicode character"; 3039f11ffb7Safresh1} 3049f11ffb7Safresh1{ 3059f11ffb7Safresh1 my $input = $valid_mime . " " . $invalid_mime; 3069f11ffb7Safresh1 my $output = Encode::decode("MIME-Header", $input, Encode::FB_QUIET | Encode::LEAVE_SRC); 3079f11ffb7Safresh1 is $output => Encode::decode("MIME-Header", $valid_mime), "decode with FB_QUIET and LEAVE_SRC flags: output string stops before first mime word with unknown charset"; 3089f11ffb7Safresh1 is $input => $valid_mime . " " . $invalid_mime, "decode with FB_QUIET flag: input string is not modified"; 3099f11ffb7Safresh1} 3109f11ffb7Safresh1{ 3119f11ffb7Safresh1 my $input = $valid_mime . " " . $invalid_mime_unicode; 3129f11ffb7Safresh1 my $output = Encode::decode("MIME-Header", $input, Encode::FB_QUIET | Encode::LEAVE_SRC); 3139f11ffb7Safresh1 is $output => Encode::decode("MIME-Header", $valid_mime), "decode with FB_QUIET and LEAVE_SRC flags: output string stops before first mime word with invalid unicode character"; 3149f11ffb7Safresh1 is $input => $valid_mime . " " . $invalid_mime_unicode, "decode with FB_QUIET flag: input string is not modified"; 3159f11ffb7Safresh1} 3169f11ffb7Safresh1{ 3179f11ffb7Safresh1 my $input = $valid_mime . " " . $invalid_mime; 3189f11ffb7Safresh1 my $output = Encode::decode("MIME-Header", $input, Encode::FB_PERLQQ); 3199f11ffb7Safresh1 is $output => Encode::decode("MIME-Header", $valid_mime) . " " . $invalid_mime, "decode with FB_PERLQQ flag: output string contains unmodified mime word with unknown charset"; 3209f11ffb7Safresh1 is $input => $valid_mime . " " . $invalid_mime, "decode with FB_QUIET flag: input string is not modified"; 3219f11ffb7Safresh1} 3229f11ffb7Safresh1{ 3239f11ffb7Safresh1 my $input = $valid_mime . " " . $invalid_mime_unicode; 3249f11ffb7Safresh1 my $output = Encode::decode("MIME-Header", $input, Encode::FB_PERLQQ); 3259f11ffb7Safresh1 is $output => Encode::decode("MIME-Header", $valid_mime) . '(\xC3)', "decode with FB_PERLQQ flag: output string contains perl qq representation of invalid unicode character"; 3269f11ffb7Safresh1 is $input => $valid_mime . " " . $invalid_mime_unicode, "decode with FB_QUIET flag: input string is not modified"; 3279f11ffb7Safresh1} 3289f11ffb7Safresh1{ 3299f11ffb7Safresh1 my $input = $valid_mime; 3309f11ffb7Safresh1 my $output = Encode::decode("MIME-Header", $input, sub { sprintf("!0x%X!", $_[0]) }); 3319f11ffb7Safresh1 is $output => Encode::decode("MIME-Header", $valid_mime), "decode valid with coderef check: output string is valid"; 3329f11ffb7Safresh1 is $input => $valid_mime, "decode valid with coderef check: input string is not modified"; 3339f11ffb7Safresh1} 3349f11ffb7Safresh1{ 3359f11ffb7Safresh1 my $input = $valid_mime . " " . $invalid_mime; 3369f11ffb7Safresh1 my $output = Encode::decode("MIME-Header", $input, sub { sprintf("!0x%X!", $_[0]) }); 3379f11ffb7Safresh1 is $output => Encode::decode("MIME-Header", $valid_mime) . " " . $invalid_mime, "decode with coderef check: output string contains unmodified mime word with unknown charset"; 3389f11ffb7Safresh1 is $input => $valid_mime . " " . $invalid_mime, "decode with coderef check: input string is not modified"; 3399f11ffb7Safresh1} 3409f11ffb7Safresh1{ 3419f11ffb7Safresh1 my $input = $valid_mime . " " . $invalid_mime_unicode; 3429f11ffb7Safresh1 my $output = Encode::decode("MIME-Header", $input, sub { sprintf("!0x%X!", $_[0]) }); 3439f11ffb7Safresh1 is $output => Encode::decode("MIME-Header", $valid_mime) . '(!0xC3!)', "decode with coderef check: output string contains output from coderef for invalid unicode character"; 3449f11ffb7Safresh1 is $input => $valid_mime . " " . $invalid_mime_unicode, "decode with coderef check: input string is not modified"; 3459f11ffb7Safresh1} 3469f11ffb7Safresh1 3479f11ffb7Safresh1__END__ 348