File Coverage

lib/Sisimai/RFC3834.pm
Criterion Covered Total %
statement 75 75 100.0
branch 33 48 68.7
condition 4 7 57.1
subroutine 5 5 100.0
pod 2 2 100.0
total 119 137 86.8


line stmt bran cond sub pod time code
1             package Sisimai::RFC3834;
2 6     6   4777 use feature ':5.10';
  6         11  
  6         500  
3 6     6   44 use strict;
  6         17  
  6         122  
4 6     6   30 use warnings;
  6         14  
  6         5939  
5              
6             # http://tools.ietf.org/html/rfc3834
7 2     2 1 839 sub description { 'Detector for auto replied message' }
8             sub make {
9             # Detect auto reply message as RFC3834
10             # @param [Hash] mhead Message headers of a bounce email
11             # @param [String] mbody Message body of a bounce email
12             # @return [Hash] Bounce data list and message/rfc822 part
13             # @return [Undef] failed to parse or the arguments are missing
14             # @since v4.1.28
15 31     31 1 352 my $class = shift;
16 31   100     122 my $mhead = shift // return undef;
17 30   50     102 my $mbody = shift // return undef;
18 30         49 my $leave = 0;
19 30         46 my $match = 0;
20              
21 30 50       102 return undef unless keys %$mhead;
22 30 50       100 return undef unless ref $mbody eq 'SCALAR';
23              
24 30         170 my $markingsof = { 'boundary' => qr/\A__SISIMAI_PSEUDO_BOUNDARY__\z/ };
25 30         96 state $autoreply1 = {
26             # http://www.iana.org/assignments/auto-submitted-keywords/auto-submitted-keywords.xhtml
27             'auto-submitted' => qr/\Aauto-(?:generated|replied|notified)/,
28             # https://msdn.microsoft.com/en-us/library/ee219609(v=exchg.80).aspx
29             'x-auto-response-suppress' => qr/(?:oof|autoreply)/,
30             'x-apple-action' => qr/\Avacation\z/,
31             'precedence' => qr/\Aauto_reply\z/,
32             'subject' => qr/\A(?>
33             auto:
34             |auto[ ]response:
35             |automatic[ ]reply:
36             |out[ ]of[ ](?:the[ ])*office:
37             )
38             /x,
39             };
40 30         77 state $excludings = {
41             'subject' => qr{(?:
42             security[ ]information[ ]for # sudo
43             |mail[ ]failure[ ][-] # Exim
44             )
45             }x,
46             'from' => qr/(?:root|postmaster|mailer-daemon)[@]/,
47             'to' => qr/root[@]/,
48             };
49 30         60 state $subjectset = qr{\A(?>
50             (?:.+?)?re:
51             |auto(?:[ ]response):
52             |automatic[ ]reply:
53             |out[ ]of[ ]office:
54             )
55             [ ]*(.+)\z
56             }x;
57              
58 30         106 DETECT_EXCLUSION_MESSAGE: for my $e ( keys %$excludings ) {
59             # Exclude message from root@
60 86 50       177 next unless exists $mhead->{ $e };
61 86 50       181 next unless defined $mhead->{ $e };
62 86 100       566 next unless lc($mhead->{ $e }) =~ $excludings->{ $e };
63 3         6 $leave = 1;
64 3         3 last;
65             }
66 30 100       103 return undef if $leave;
67              
68 27         136 DETECT_AUTO_REPLY_MESSAGE: for my $e ( keys %$autoreply1 ) {
69             # RFC3834 Auto-Submitted and other headers
70 75 100       150 next unless exists $mhead->{ $e };
71 32 50       79 next unless defined $mhead->{ $e };
72 32 100       253 next unless lc($mhead->{ $e }) =~ $autoreply1->{ $e };
73 21         39 $match++;
74 21         45 last;
75             }
76 27 100       89 return undef unless $match;
77              
78 21         117 require Sisimai::Lhost;
79 21         112 my $dscontents = [Sisimai::Lhost->DELIVERYSTATUS];
80 21         47 my $recipients = 0; # (Integer) The number of 'Final-Recipient' header
81 21         43 my $maxmsgline = 5; # (Integer) Max message length(lines)
82 21         33 my $haveloaded = 0; # (Integer) The number of lines loaded from message body
83 21         35 my $blanklines = 0; # (Integer) Counter for countinuous blank lines
84 21         31 my $countuntil = 1; # (Integer) Maximun value of blank lines in the body part
85 21         38 my $v = $dscontents->[-1];
86              
87             RECIPIENT_ADDRESS: {
88             # Try to get the address of the recipient
89 21         26 for my $e ('from', 'return-path') {
  21         42  
90             # Get the recipient address
91 21 50       84 next unless exists $mhead->{ $e };
92 21 50       56 next unless defined $mhead->{ $e };
93              
94 21         51 $v->{'recipient'} = $mhead->{ $e };
95 21         37 last;
96             }
97              
98 21 50       71 if( $v->{'recipient'} ) {
99             # Clean-up the recipient address
100 21         131 $v->{'recipient'} = Sisimai::Address->s3s4($v->{'recipient'});
101 21         43 $recipients++;
102             }
103             }
104 21 50       63 return undef unless $recipients;
105              
106 21 100       77 if( $mhead->{'content-type'} ) {
107             # Get the boundary string and set regular expression for matching with
108             # the boundary string.
109 15         72 my $b0 = Sisimai::MIME->boundary($mhead->{'content-type'}, 0);
110 15 50       54 $markingsof->{'boundary'} = qr/\A\Q$b0\E\z/ if length $b0;
111             }
112              
113             BODY_PARSER: {
114             # Get vacation message
115 21         38 for my $e ( split("\n", $$mbody) ) {
  21         118  
116             # Read the first 5 lines except a blank line
117 48 50       187 $countuntil += 1 if $e =~ $markingsof->{'boundary'};
118              
119 48 100       104 unless( length $e ) {
120             # Check a blank line
121 16 100       56 last if ++$blanklines > $countuntil;
122 11         20 next;
123             }
124 32 50       80 next unless rindex($e, ' ') > -1;
125 32 50       90 next if index($e, 'Content-Type') == 0;
126 32 50       86 next if index($e, 'Content-Transfer') == 0;
127              
128 32         97 $v->{'diagnosis'} .= $e.' ';
129 32         41 $haveloaded++;
130 32 50       79 last if $haveloaded >= $maxmsgline;
131             }
132 21   33     84 $v->{'diagnosis'} ||= $mhead->{'subject'};
133             }
134              
135 21         143 $v->{'diagnosis'} = Sisimai::String->sweep($v->{'diagnosis'});
136 21         55 $v->{'reason'} = 'vacation';
137 21         55 $v->{'date'} = $mhead->{'date'};
138 21         60 $v->{'status'} = '';
139              
140             # Get the Subject header from the original message
141 21 100       315 my $rfc822part = lc($mhead->{'subject'}) =~ $subjectset ? 'Subject: '.$1."\n" : '';
142 21         180 return { 'ds' => $dscontents, 'rfc822' => $rfc822part };
143             }
144              
145             1;
146             __END__