rt/t/mail/rfc822-attachment.t

   1 use strict;
   2 use warnings;
   3
   4 use RT::Test tests => undef;
   5
   6 use MIME::Entity;
   7
   8 diag "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
  56 diag "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
 112 sub 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
 122 sub 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
 136 done_testing;
 137