1use strict; 2use warnings; 3 4use RT::Test tests => undef; 5 6use MIME::Entity; 7 8diag "simple rfc822 attachment"; 9{ 10 11 my $top = MIME::Entity->build( 12 From => 'root@localhost', 13 To => 'rt@localhost', 14 Subject => 'this is top', 15 Data => ['top mail'], 16 ); 17 18 my $rfc822 = MIME::Entity->build( 19 From => 'foo@localhost', 20 To => 'bar@localhost', 21 Subject => 'rfc822', 22 Data => ['rfc822 attachment'], 23 'X-Brokenness' => 'high', 24 ); 25 26 $top->attach( 27 Data => $rfc822->stringify, 28 Type => 'message/rfc822', 29 ); 30 31 my $parsed = content_as_mime($top); 32 33 for my $mime ($top, $parsed) { 34 diag "testing mail"; 35 is $mime->parts, 2, 'two mime parts'; 36 37 like $mime->head->get('Subject'), qr/this is top/, 'top subject'; 38 like $mime->head->get('From'), qr/root\@localhost/, 'top From'; 39 like $mime->parts(0)->bodyhandle->as_string, qr/top mail/, 'content of top'; 40 41 my $attach = $mime->parts(1); 42 my $body = $attach->bodyhandle->as_string; 43 44 like $attach->head->mime_type, qr/message\/rfc822/, 'attach of type message/rfc822'; 45 like $body, qr/rfc822 attachment/, 'attach content'; 46 47 headers_like( 48 $attach, 49 Subject => 'rfc822', 50 From => 'foo@localhost', 51 'X-Brokenness' => 'high', 52 ); 53 } 54} 55 56diag "multipart rfc822 attachment"; 57{ 58 59 my $top = MIME::Entity->build( 60 From => 'root@localhost', 61 To => 'rt@localhost', 62 Subject => 'this is top', 63 Data => ['top mail'], 64 ); 65 66 my $rfc822 = MIME::Entity->build( 67 From => 'foo@localhost', 68 To => 'bar@localhost', 69 Subject => 'rfc822', 70 Data => ['rfc822 attachment'], 71 'X-Brokenness' => 'high', 72 ); 73 74 $rfc822->attach( 75 Data => '<b>attachment of rfc822 attachment</b>', 76 Type => 'text/html', 77 ); 78 79 $top->attach( 80 Data => $rfc822->stringify, 81 Type => 'message/rfc822', 82 ); 83 84 my $parsed = content_as_mime($top); 85 86 for my $mime ($top, $parsed) { 87 diag "testing mail"; 88 is $mime->parts, 2, 'two mime parts'; 89 90 like $mime->head->get('Subject'), qr/this is top/, 'top subject'; 91 like $mime->head->get('From'), qr/root\@localhost/, 'top From'; 92 like $mime->parts(0)->bodyhandle->as_string, qr/top mail/, 'content of top'; 93 94 my $attach = $mime->parts(1); 95 my $body = $attach->bodyhandle->as_string; 96 97 like $attach->head->mime_type, qr/message\/rfc822/, 'attach of type message/rfc822'; 98 like $body, qr/rfc822 attachment/, 'attach content'; 99 like $body, qr/attachment of rfc822 attachment/, 'attach content'; 100 101 headers_like( 102 $attach, 103 Subject => 'rfc822', 104 From => 'foo@localhost', 105 'X-Brokenness' => 'high', 106 'Content-Type' => 'text/plain', 107 'Content-type' => 'text/html', 108 ); 109 } 110} 111 112sub content_as_mime { 113 my $entity = shift; 114 my ( $status, $id ) = RT::Test->send_via_mailgate($entity); 115 is( $status >> 8, 0, "The mail gateway exited normally" ); 116 ok( $id, "created ticket" ); 117 # We can't simply use Txn->ContentAsMIME since that is wrapped in a 118 # message/rfc822 entity 119 return RT::Test->last_ticket->Transactions->First->Attachments->First->ContentAsMIME(Children => 1); 120} 121 122sub headers_like { 123 my $attach = shift; 124 my %header = (@_); 125 my $body = $attach->bodyhandle->as_string; 126 for my $name (keys %header) { 127 if (lc $name eq 'content-type') { 128 like $attach->head->get($name), qr/message\/rfc822/, "attach $name message/rfc822, not from a subpart"; 129 } else { 130 is $attach->head->get($name), undef, "attach $name not in part header"; 131 } 132 like $body, qr/$name: $header{$name}/i, "attach $name in part body"; 133 } 134} 135 136done_testing; 137 138