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